home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / isamexpt / wntisam4.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  80.6 KB  |  1,958 lines
  1. {HISTORY of Changes:
  2.   ********* VERSION 1.04 *********
  3.   18.01.1996 Property NAME of ISAMBROWSER changed form ISAMBROWSER1 to RECORDNAME+BROWSER1
  4.   20.01.1996 Length of DBASE-FIELDNAMES = 8, search for fieldnames that already exist
  5.   }
  6.  
  7. unit Wntisam4;
  8.  
  9. interface
  10.  
  11. Uses Classes, DB;
  12. {$I DEFINE.PAS}
  13. function Erzeuge_BrowserSource(const UnitIdent, FormIdent,
  14.                                EditUnitIdent,EditFormIdent: String;
  15.                                alsMainform: Boolean;
  16.                                RecList,KeyList,IIDList: TStringList;
  17.                                DBase_Export,DBase_Import: Boolean;
  18.                                StruFileName: String;
  19.                                Sprache: Integer;
  20.                                CreaBttn, SetupBttnCheck: Boolean;
  21.                                TypDateiName, AliasName: String): TMemoryStream;
  22.  
  23. function Erzeuge_EditorSource(const UnitIdent, FormIdent: string;
  24.                               RecList,KeyList: TStringList;
  25.                               Sprache: Integer;
  26.                               TypDateiName: String): TMemoryStream;
  27.  
  28. Function GetFieldTypEditor(S: String;
  29.                            var FieldName: String;
  30.                            var FieldDataType: TFieldType;
  31.                            var Len: Integer;
  32.                            var Arr1,Arr2: Integer;
  33.                            var Decimals: Integer): Byte;
  34.  
  35. procedure FmtWrite(Stream: TStream; Fmt: PChar;
  36.                    const Args: array of const);
  37.  
  38. implementation
  39.  
  40. Uses SysUtils, UToolDll, Wnt_Base;
  41.  
  42. procedure FmtWrite(Stream: TStream; Fmt: PChar;
  43.                    const Args: array of const);
  44. begin
  45.   if (Stream <> nil) and (SourceBuffer <> nil) then
  46.   begin
  47.     StrLFmt(SourceBuffer, SourceBufferSize, Fmt, Args);
  48.     Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  49.   end;
  50. end;
  51.  
  52. Function GetBrowserString(NStr,FormIdent: String; Arr: Integer;
  53.                           var JChar: String): String;
  54. var S,FeldName,AStr: String;
  55. begin
  56.   S:= '';
  57.   JChar:= '|^';
  58.   FeldName:= Copy(NStr,1,Pos(':',NStr)-1);
  59.   Strip(FeldName);
  60.   if Arr > 0 then begin
  61.     Str(Arr,AStr);
  62.     FeldName:= FeldName+'['+AStr+']';
  63.   end;
  64.   if (Length(FeldName) > 0) and (Pos('DUMMY',NStr) = 0)
  65.   and (Pos('MEMO',NStr) = 0) and (Pos('IGNORE',NStr) = 0) then begin
  66.     if Pos('WORD',NStr) > 0 then begin
  67.       if (Pos('DATUM',NStr) > 0) or (Pos('DATE',NStr) > 0) then begin
  68.         S:= 'DateStr('+FeldName+')';
  69.       end
  70.       else begin
  71.         S:= 'DelSpace(IntStr('+FeldName+'))';
  72.         JChar:= '░^';
  73.       end;
  74.     end
  75.     else if Pos('INTEGER',NStr) > 0 then begin
  76.       S:= 'DelSpace(IntStr('+FeldName+'))';
  77.       JChar:= '░^';
  78.     end
  79.     else if Pos('BYTE',NStr) > 0 then begin
  80.       S:= 'DelSpace(IntStr('+FeldName+'))';
  81.       JChar:= '░^';
  82.     end
  83.     else if Pos('LONGINT',NStr) > 0 then begin
  84.       if (Pos('DATUM',NStr) > 0) or (Pos('DATE',NStr) > 0) then begin
  85.         S:= 'DateStr('+FeldName+')';
  86.       end
  87.       else begin
  88.         S:= 'DelSpace(IntStr('+FeldName+'))';
  89.         JChar:= '░^';
  90.       end;
  91.     end
  92.     else if Pos('REAL',NStr) > 0 then begin
  93.       S:= 's:= DelSpace(SimpleFormDezStr('+FeldName+',12,2))';
  94.       JChar:= '░^';
  95.     end
  96.     else if (Pos('CHAR',NStr) > 0) and (Pos('ARRAY',NStr) = 0) then begin
  97.       S:= FeldName;
  98.     end
  99.     else if (Pos('BOOLEAN',NStr) > 0) then begin
  100.       S:= 'BoolStr('+FeldName+')';
  101.     end
  102.     else S:= 'String_oem2ansi(Table.AnsiConvert,'+FeldName+')'
  103.   end;
  104.   GetBrowserString:= S;
  105. end;
  106.  
  107. Function GetFieldTypEditor(S: String;
  108.                            var FieldName: String;
  109.                            var FieldDataType: TFieldType;
  110.                            var Len: Integer;
  111.                            var Arr1,Arr2: Integer;
  112.                            var Decimals: Integer): Byte;
  113. var G: Byte;
  114.     x,Code,A1,A2,xPos: Integer;
  115.     SStr,AStr,A1Str,NStr: String;
  116. begin
  117.   Arr1:= 1;
  118.   Arr2:= 1;
  119.   Decimals:= 0;
  120.   SStr:= UpperCase(S);
  121.   AStr:= SStr;
  122.   if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
  123.     Delete(AStr,1,Pos('ARRAY[',AStr)+5);
  124.     if Pos(']',AStr) > 0 then begin
  125.       AStr:= Copy(AStr,1,Pos(']',AStr)-1);
  126.       if Pos('.',AStr) > 0 then begin
  127.         A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
  128.         While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
  129.         Strip(a1Str); Strip(AStr);
  130.         Val(A1Str,A1,Code);
  131.         Val(AStr,A2,Code);
  132.         if (A1 > 0) and (A2 > 0) then begin
  133.           Arr1:= A1;
  134.           Arr2:= A2;
  135.           if Arr1 > Arr2 then begin
  136.             A1:= Arr2;
  137.             Arr2:= Arr1;
  138.             Arr1:= A1;
  139.           end;
  140.         end;
  141.       end;
  142.     end;
  143.   end;
  144.   if (Pos('DATUM',SStr) > 0) or (Pos('DATE',SStr) > 0) then begin
  145.     G:= 1;
  146.     FieldDataType:= ftDate;
  147.     Len:= 10;
  148.   end
  149.   else if (Pos('REAL',SStr) > 0) or (Pos('INTEGER',SStr) > 0)
  150.   or (Pos('BYTE',SStr) > 0) or (Pos('WORD',SStr) > 0)
  151.   or (Pos('LONGINT',SStr) > 0) then begin
  152.     G:= 2;
  153.     if Pos('REAL',SStr) > 0 then begin
  154.       FieldDataType:= ftFLOAT;
  155.       Len:= 10;
  156.       Decimals:= 2;
  157.       NStr:= SStr;
  158.       Strip(NStr);
  159.       xPos:= Pos('{NACHK',NStr);
  160.       if xPos > 0 then begin
  161.         Delete(NStr,1,Pos('{NACHK',NStr)+5);
  162.         if Pos('OMMASTELLEN',NStr) > 0 then Delete(NStr,Pos('OMMASTELLEN',NStr),11);
  163.         if Pos('=',NStr) > 0 then Delete(NStr,Pos('=',NStr),1);
  164.         xPos:= Pos('}',NStr);
  165.         if xPos > 0 then begin
  166.           NStr:= Copy(NStr,1,xPos-1);
  167.           Strip(NStr);
  168.           Val(NStr,x,Code);
  169.           if x > 0 then Decimals:= x;
  170.         end;
  171.       end
  172.       else begin
  173.         xPos:= Pos('{DECIMALS=',NStr);
  174.         if xPos > 0 then begin
  175.           Delete(NStr,1,Pos('{DECIMALS=',NStr)+9);
  176.           xPos:= Pos('}',NStr);
  177.           if xPos > 0 then begin
  178.             NStr:= Copy(NStr,1,xPos-1);
  179.             Strip(NStr);
  180.             Val(NStr,x,Code);
  181.             if x > 0 then Decimals:= x;
  182.           end;
  183.         end;
  184.       end;
  185.     end
  186.     else if Pos('INTEGER',SStr) > 0 then begin
  187.       FieldDataType:= ftSMALLINT;
  188.       Len:= 8;
  189.     end
  190.     else if Pos('BYTE',SStr) > 0 then begin
  191.       FieldDataType:= ftSMALLINT;
  192.       Len:= 4;
  193.     end
  194.     else if Pos('WORD',SStr) > 0 then begin
  195.       FieldDataType:= ftWORD;
  196.       Len:= 8;
  197.     end
  198.     else begin
  199.       FieldDataType:= ftINTEGER;
  200.       Len:= 12;
  201.     end;
  202.   end
  203.   else if (Pos('MEMO',SStr) > 0) then begin
  204.     G:= 3;
  205.     FieldDataType:= ftMEMO;
  206.     Len:= 255;
  207.   end
  208.   else if (Pos('BOOLEAN',SStr) > 0) then begin
  209.     G:= 4;
  210.     FieldDataType:= ftBOOLEAN;
  211.     Len:= 2;
  212.   end
  213.   else begin
  214.     G:= 0;
  215.     FieldDataType:= ftString;
  216.     Strip(SStr);
  217.     Len:= 255;
  218.     if Pos('ARRAY[',SStr) > 0 then begin
  219.       Delete(SStr,1,Pos(']',SStr));
  220.       if SStr[1] = ']' then Delete(SStr,1,1);
  221.     end
  222.     else if Pos('CHAR',SStr) > 0 then Len:= 1;
  223.     if Pos('[',SStr) > 0 then begin
  224.       Delete(SStr,1,Pos('[',SStr));
  225.       if Pos(']',SStr) > 0 then begin
  226.         SStr:= Copy(SStr,1,Pos(']',SStr)-1);
  227.         Val(SStr,Len,Code);
  228.       end;
  229.     end;
  230.   end;
  231.   Strip(S);
  232.   FieldName:= Copy(S,1,Pos(':',S)-1);
  233.   Strip(FieldName);
  234.   GetFieldTypEditor:= G;
  235. end;
  236.  
  237. Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
  238. var A1Str: String;
  239.     A1,A2,Code: Integer;
  240. begin
  241.   Arr1:= 1;
  242.   Arr2:= 1;
  243.   if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
  244.     Delete(AStr,1,Pos('ARRAY[',AStr)+5);
  245.     if Pos(']',AStr) > 0 then begin
  246.       AStr:= Copy(AStr,1,Pos(']',AStr)-1);
  247.       if Pos('.',AStr) > 0 then begin
  248.         A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
  249.         While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
  250.         Strip(a1Str); Strip(AStr);
  251.         Val(A1Str,A1,Code);
  252.         Val(AStr,A2,Code);
  253.         if (A1 > 0) and (A2 > 0) then begin
  254.           Arr1:= A1;
  255.           Arr2:= A2;
  256.           if Arr1 > Arr2 then begin
  257.             A1:= Arr2;
  258.             Arr2:= Arr1;
  259.             Arr1:= A1;
  260.           end;
  261.         end;
  262.       end;
  263.     end;
  264.   end;
  265. end;
  266.  
  267. function Erzeuge_BrowserSource(const UnitIdent, FormIdent,
  268.                                EditUnitIdent,EditFormIdent: String;
  269.                                alsMainform: Boolean;
  270.                                RecList,KeyList,IIDList: TStringList;
  271.                                DBase_Export,DBase_Import: Boolean;
  272.                                StruFileName: String;
  273.                                Sprache: Integer;
  274.                                CreaBttn, SetupBttnCheck: Boolean;
  275.                                TypDateiName,AliasName: String): TMemoryStream;
  276. const
  277.   CRLF = #13#10;
  278. Var Decimals,Len,fnx,I,x,k,arr1,arr2,a,Feld: integer;
  279.     G: Byte;
  280.     BStr,SStr,RStr,xStr,NStr,DbFldNam : String;
  281.     ArrName,Zeichen,RecordName,FldNam,FeldName: String;
  282.     DBFeldList: TStringList;
  283.     JustChar,MemoName: String;
  284.     FieldDataType: TFieldType;
  285. begin
  286.   SourceBuffer := StrAlloc(SourceBufferSize);
  287.   try
  288.     Result := TMemoryStream.Create;
  289.     try
  290.       DBFeldList:= TStringList.Create;
  291.       { unit header and uses clause }
  292.       FmtWrite(Result,
  293.         'unit %s;' + CRLF + CRLF +
  294.         'interface' + CRLF + CRLF +
  295.         'uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Menus,'+CRLF,[UnitIdent]);
  296.       FmtWrite(Result,
  297.         '     Dialogs, StdCtrls, Buttons, ExtCtrls,'+CRLF+
  298.         '     IsamTabl, FvcBrows, LowBrows, IsamBrow, IsamNav,'+CRLF+
  299.         '     Filer, DbTables, UUseisam;'+CRLF+CRLF,[NIL]);
  300.       RecordName:= '';
  301.       MemoName:= '';
  302.       FmtWrite(Result,'{$I %s}'+CRLF+CRLF,[TypDateiName]);
  303.  
  304.       if RecList.Count > 0 then begin
  305.         For x:= 0 to RecList.Count-1 do begin
  306.           RStr:= RecList[x];
  307.           {FmtWrite(Result,'%s'+CRLF,[RStr]);}
  308.           RStr:= UpperCase(RStr);
  309.           Strip(RStr);
  310.           if Pos('=RECORD',RStr) > 0 then begin
  311.             RStr:= Copy(RStr,1,Pos('=RECORD',RStr)-1);
  312.             Strip(RStr);
  313.             RecordName:= RStr;
  314.           end;
  315.           if (Pos(':',RStr) > 0) and (Pos('DUMMY',UpperCase(RStr)) = 0)
  316.           and (Pos('IGNORE',Uppercase(RStr)) = 0) then begin
  317.             G:= GetFieldTypEditor(RStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  318.             if G = 3 then MemoName:= FeldName;
  319.           end;
  320.         end;
  321.       end;
  322.       FmtWrite(Result,
  323.         'type'#13#10 +
  324.         '  T%s = class(TForm)'+CRLF,[FormIdent]);
  325.  
  326.       FmtWrite(Result,
  327.         '    StatusBar  : TPanel;'       +CRLF+
  328.         '    Panel1     : TPanel;'          +CRLF+
  329.         '    Panel2     : TPanel;'  + CRLF,[NIL]);
  330.       FmtWrite(Result,
  331.         '    KeyPanel   : TPanel;' + CRLF +
  332.         '    ZeitPanel  : TPanel;'+ CRLF,[NIL]);
  333.       FmtWrite(Result,
  334.         '    %sTimer   : TTimer;'+ CRLF +
  335.         '    Header1   : THeader;'+CRLF+
  336.         '    %sTable    : TIsamTable;'+CRLF,[FormIdent,FormIdent]);
  337.       FmtWrite(Result,
  338.         '    NeuBttn    : TSpeedButton;' +CRLF+
  339.         '    EditBttn   : TSpeedButton;'+CRLF+
  340.         '    SuchBttn   : TSpeedButton;' +CRLF,[NIL]);
  341.       FmtWrite(Result,
  342.         '    KeyBttn    : TSpeedButton;' +CRLF+
  343.         '    LoeschBttn : TSpeedButton;'+CRLF+
  344.         '    ReorgBttn  : TSpeedButton;'+CRLF,[NIL]);
  345.       FmtWrite(Result,
  346.         '    BrwBttn    : TSpeedButton;'+CRLF,[NIL]);
  347.  
  348.       if DBASE_Export then begin
  349.         FmtWrite(Result,
  350.         '    DbExpBttn  : TSpeedButton;'+CRLF,[NIL]);
  351.       end;
  352.       if DBASE_Import then begin
  353.         FmtWrite(Result,
  354.         '    DbImpBttn  : TSpeedButton;'+CRLF,[NIL]);
  355.       end;
  356.       if CreaBttn then begin
  357.         FmtWrite(Result,
  358.         '    CreateBttn : TSpeedButton;'+CRLF,[NIL]);
  359.       end;
  360.       if SetupBttnCheck then begin
  361.         FmtWrite(Result,
  362.         '    SetupBttn  : TSpeedButton;'+CRLF,[NIL]);
  363.       end;
  364.       FmtWrite(Result,
  365.         '    ExitBttn   : TSpeedButton;'+CRLF,[NIL]);
  366.       FmtWrite(Result,
  367.         '    %sBrowser1: TIsamBrowser;'+CRLF+
  368.         '    IsamNavigator1: TIsamNavigator;'+CRLF,[RecordName]);
  369.       FmtWrite(Result,
  370.         '    procedure ShowHint(Sender: TObject);'     +CRLF+
  371.         '    procedure FormCreate(Sender: TObject);'   +CRLF+
  372.         '    Procedure FormResize(Sender: TObject);'   +CRLF,[NIL]);
  373.       FmtWrite(Result,
  374.         '    Procedure FormShow(Sender: TObject);' + CRLF+
  375.         '    Procedure Header1Sized(Sender: TObject; ASection, AWidth: Integer);' + CRLF +
  376.         '    Function %sBrowser1BuildRow(Sender: TObject; var RR: RowRec): Integer;' + CRLF,[RecordName]);
  377.  
  378.       FmtWrite(Result,
  379.         '    procedure ExitBttnClick(Sender: TObject);'+CRLF+
  380.         '    procedure FormDestroy(Sender: TObject);' +CRLF,[NIL]);
  381.       FmtWrite(Result,
  382.         '    procedure EditBttnClick(Sender: TObject);'+CRLF+
  383.         '    procedure NeuBttnClick(Sender: TObject);' +CRLF+
  384.         '    procedure SuchBttnClick(Sender: TObject);' +CRLF,[NIL]);
  385.       FmtWrite(Result,
  386.         '    procedure KEYBttnClick(Sender: TObject);'  +CRLF+
  387.         '    procedure LoeschBttnClick(Sender: TObject);' + CRLF+
  388.         '    Procedure %sTimerTimer(Sender: TObject);'  + CRLF,[FormIdent]);
  389.       FmtWrite(Result,
  390.         '    Procedure ReorgBttnClick(Sender: TObject);' + CRLF+
  391.         '    Procedure BrwBttnClick(Sender: TObject);' + CRLF,[NIL]);
  392.       if DBASE_Export then begin
  393.         FmtWrite(Result,
  394.           '    Procedure DBExpBttnClick(Sender: TObject);'+CRLF,[NIL]);
  395.       end;
  396.       if DBASE_Import then begin
  397.         FmtWrite(Result,
  398.           '    Procedure DBImpBttnClick(Sender: TObject);'+CRLF,[NIL]);
  399.       end;
  400.       if CreaBttn then begin
  401.         FmtWrite(Result,
  402.           '    Procedure CreateBttnClick(Sender: TObject);'+CRLF,[NIL]);
  403.       end;
  404.       if SetupBttnCheck then begin
  405.         FmtWrite(Result,
  406.           '    Procedure SetupBttnClick(Sender: TObject);'+CRLF,[NIL]);
  407.       end;
  408.       FmtWrite(Result,
  409.         '  Private'+CRLF+
  410.         '    KeyListe: TStringList;'+CRLF+
  411.         '    Procedure Set_Language;'+CRLF,[NIL]);
  412.       FmtWrite(Result,
  413.         '  public' +CRLF+
  414.         '    %sData: %s;'+CRLF+
  415.         '    %sDup : %s;'+CRLF+
  416.         'end;'+CRLF+CRLF,[RecordName,RecordName,RecordName,RecordName]);
  417.       FmtWrite(Result,
  418.       'Function %sKeyProc(Var Daten; KeyNr:Word): IsamKeyStr; FAR;'+CRLF+CRLF,[RecordName]);
  419.  
  420.       if DBASE_Export then begin
  421.         FmtWrite(Result,
  422.           'Procedure %sDbaseExportProc(var DATA; DBTable: TTable; ISTable: TIsamTable); far;'+CRLF,[RecordName]);
  423.       end;
  424.  
  425.       FmtWrite(Result,
  426.         'var' + CRLF +
  427.         '  %s: T%s;' + CRLF + CRLF +
  428.         'implementation' + CRLF + CRLF,[FormIdent,FormIdent]);
  429.       if (DBase_Export = False) and (DBase_Import = False) then
  430.         FmtWrite(Result,
  431.           'uses SysUtils, UToolDll, Isam_Key, IsamSuch, %s, Dat;'+CRLF,[EditUnitIdent])
  432.       else begin
  433.         FmtWrite(Result,
  434.           'uses SysUtils, UToolDll, Isam_Key, IsamSuch,'+CRLF+
  435.           '%s, Isam2Dbf, Dbf2Isam, %s, Dat;'+CRLF,[EditUnitIdent,StruFileName])
  436.       end;
  437.       FmtWrite(Result,
  438.         '{$R *.DFM}' + CRLF + CRLF, [EditUnitIdent]);
  439.  
  440.       FmtWrite(Result,
  441.         'Function %sGetFeldProc(Feld: Integer; Table: TIsamTable; var DATA): String; far;'+CRLF+
  442.         'var S: String;'+CRLF+
  443.         'begin'+CRLF,[RecordName]);
  444.       FmtWrite(Result,
  445.         '  S:= '+Chr(39)+Chr(39)+';'+CRLF+
  446.         '  With %s(Data) do begin'+CRLF+
  447.         '    Case Feld of'+CRLF,[RecordName]);
  448.       if RecList.Count > 0 then begin
  449.         Feld:= 0;
  450.         For x:= 0 to RecList.Count-1 do begin
  451.           NStr:= RecList[x];
  452.           NStr:= Uppercase(NStr);
  453.           Strip(NStr);
  454.           if (Pos(':',NStr) > 0) then begin
  455.             GetArray(NStr,Arr1,Arr2);
  456.             if Arr1 = Arr2 then begin
  457.               A:= 0;
  458.               JustChar:= '|^';
  459.               BStr:= GetBrowserString(NStr,FormIdent,A,JustChar);
  460.               if BStr <> '' then begin
  461.                 Inc(Feld);
  462.                 if Pos('REAL',NStr) > 0 then begin
  463.                     JustChar := '░^';
  464.                     FmtWrite(Result,'      %s: %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
  465.                 end
  466.                 else
  467.                   FmtWrite(Result,'      %s: s:= %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
  468.               end;
  469.             end
  470.             else begin
  471.               For a:= arr1 to Arr2 do begin
  472.                 BStr:= GetBrowserString(NStr,FormIdent,A,JustChar);
  473.                 JustChar:= '|^';
  474.                 if BStr <> '' then begin
  475.                   Inc(Feld);
  476.                   if Pos('REAL',NStr) > 0 then begin
  477.                     JustChar := '░^';
  478.                     FmtWrite(Result,'      %s: %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
  479.                   end
  480.                   else
  481.                     FmtWrite(Result,'      %s: s:= %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
  482.                 end;
  483.               end;
  484.             end;
  485.           end;
  486.         end;
  487.       end;
  488.       FmtWrite(Result,
  489.         '    end;'+CRLF+
  490.         '  end;'+CRLF+
  491.         '  Result:= S;'+CRLF+
  492.         'end;'+CRLF+CRLF,[NIL]);
  493.  
  494.       if DBASE_Export then begin
  495.         DBFeldList.Clear;
  496.         FmtWrite(Result,
  497.           'Procedure %sDbaseExportProc(var DATA; DBTable: TTable; ISTable: TIsamTable); '+CRLF,[RecordName]);
  498.         if MemoName <> '' then FmtWrite(Result,
  499.           'var M: TMemo;'+CRLF+
  500.           '    MStr: Array[0..Sizeof(%sData.%s)+1] of Char;'+CRLF,[RecordName,MemoName]);
  501.         FmtWrite(Result,
  502.           'begin'+CRLF+
  503.           '  With %s(Data) do begin'+CRLF,[RecordName]);
  504.         if RecList.Count > 0 then begin
  505.           For X:= 0 to RecList.Count-1 do begin
  506.             RStr:= RecList[x];
  507.             RStr:= UpperCase(RStr);
  508.             Strip(RStr);
  509.             if (Pos(':',RStr) > 0) and (Pos('DUMMY',RStr) = 0) then begin
  510.               GetArray(RStr,Arr1,Arr2);
  511.               FldNam:= Copy(RStr,1,Pos(':',RStr)-1);
  512.               Strip(FldNam);
  513.               DBFldNam:= FldNam;
  514.               if Length(DBFldNam) > 8 then DBFldNam:= Copy(DBFldNam,1,8);
  515.               FeldName:= DBFldNam;
  516.               ArrName:= FldNam;
  517.               For a:= Arr1 to Arr2 do begin
  518.                 if Arr1 <> Arr2 then begin
  519.                   FeldName:= Copy(DbFldNam,1,6) + DezStr(a);
  520.                   ArrName:= FldNam + '['+DezStr(a)+']';
  521.                 end;
  522.                 if DBFeldList.Indexof(FeldName) > -1 then begin
  523.                   fnx:= 1;
  524.                   Repeat
  525.                     inc(fnx);
  526.                     FeldName:= Copy(DBFldNam,1,6)+DezStr(fnx);
  527.                   Until DBFeldList.Indexof(FeldName) = -1;
  528.                 end;
  529.                 DBFeldList.Add(FeldName);
  530.                 Zeichen:= Chr(39);
  531.                 if Pos('WORD',RStr) > 0 then begin
  532.                   if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
  533.                     FmtWrite(Result,
  534.                     '    DBTable.FieldByName(%s%s%s).AsString:= DateStr(%s);'+CRLF,
  535.                          [Zeichen,FeldName,Zeichen,ArrName]);
  536.                   end
  537.                   else begin
  538.                     FmtWrite(Result,
  539.                     '    DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
  540.                          [Zeichen,FeldName,Zeichen,ArrName]);
  541.                   end;
  542.                 end
  543.                 else if Pos('INTEGER',RStr) > 0 then begin
  544.                   FmtWrite(Result,
  545.                   '    DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
  546.                        [Zeichen,FeldName,Zeichen,ArrName]);
  547.                 end
  548.                 else if Pos('BYTE',RStr) > 0 then begin
  549.                   FmtWrite(Result,
  550.                   '    DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
  551.                        [Zeichen,FeldName,Zeichen,ArrName]);
  552.                 end
  553.                 else if Pos('LONGINT',RStr) > 0 then begin
  554.                   if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
  555.                     FmtWrite(Result,
  556.                     '    DBTable.FieldByName(%s%s%s).AsString:= DateStr(%s);'+CRLF,
  557.                          [Zeichen,FeldName,Zeichen,ArrName]);
  558.                   end
  559.                   else begin
  560.                     FmtWrite(Result,
  561.                     '    DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
  562.                        [Zeichen,FeldName,Zeichen,ArrName]);
  563.                   end
  564.                 end
  565.                 else if Pos('REAL',RStr) > 0 then begin
  566.                   FmtWrite(Result,
  567.                   '    DBTable.FieldByName(%s%s%s).AsFloat:= %s;'+CRLF,
  568.                        [Zeichen,FeldName,Zeichen,ArrName]);
  569.                 end
  570.                 else if Pos('BOOLEAN',RStr) > 0 then begin
  571.                   FmtWrite(Result,
  572.                   '    DBTable.FieldByName(%s%s%s).AsBoolean:= %s;'+CRLF,
  573.                        [Zeichen,FeldName,Zeichen,ArrName]);
  574.                 end
  575.                 else if Pos('MEMO',RStr) > 0 then begin
  576.                   FmtWrite(Result,
  577.                     '    M:= TMemo.Create(Application);'+CRLF+
  578.                     '    Move(%s,MStr,Sizeof(%s));'+CRLF+
  579.                     '    M.SetTextBuf(MStr);'+CRLF,[ArrName,ArrName]);
  580.                   FmtWrite(Result,
  581.                     '    TMemoField(DBTable.FieldByName(%s%s%s)).Assign(M.Lines);'+CRLF+
  582.                     '    M.Free;'+CRLF,
  583.                        [Zeichen,FeldName,Zeichen]);
  584.                 end
  585.                 else begin
  586.                   FmtWrite(Result,
  587.                   '    DBTable.FieldByName(%s%s%s).AsString:= String_oem2ansi(ISTable.AnsiConvert,%s);'+CRLF,
  588.                        [Zeichen,FeldName,Zeichen,ArrName]);
  589.                 end;
  590.               end;
  591.             end;
  592.           end;
  593.         end;
  594.         FmtWrite(Result,
  595.           '  end;'+CRLF+
  596.           'end;'+CRLF+CRLF,[NIL]);
  597.       end;
  598.       if DBASE_Import then begin
  599.         DBFeldList.Clear;
  600.         FmtWrite(Result,
  601.           'Procedure %sDbaseImportProc(var DATA; DBTable: TTable; ISTable: TIsamTable); far;'+CRLF,[RecordName]);
  602.         if MemoName <> '' then FmtWrite(Result,
  603.           'var M: TMemo;'+CRLF+
  604.           '    MStr: Array[0..Sizeof(%sDATA.%s)+1] of Char;'+CRLF,[RecordName,MemoName]);
  605.         FmtWrite(Result,
  606.           'begin'+CRLF+
  607.           '  Fillchar(%s(DATA),Sizeof(%s),#0);'+CRLF+
  608.           '  With %s(Data) do begin'+CRLF,[RecordName,RecordName,RecordName]);
  609.         if RecList.Count > 0 then begin
  610.           For X:= 0 to RecList.Count-1 do begin
  611.             RStr:= RecList[x];
  612.             RStr:= UpperCase(RStr);
  613.             Strip(RStr);
  614.             if (Pos(':',RStr) > 0) and (Pos('DUMMY',RStr) = 0) then begin
  615.               GetArray(RStr,Arr1,Arr2);
  616.               FldNam:= Copy(RStr,1,Pos(':',RStr)-1);
  617.               Strip(FldNam);
  618.               DBFldNam:= FldNam;
  619.               if Length(DBFldNam) > 8 then DBFldNam:= Copy(DBFldNam,1,8);
  620.               FeldName:= DBFldNam;
  621.               ArrName:= FldNam;
  622.               For a:= Arr1 to Arr2 do begin
  623.                 if Arr1 <> Arr2 then begin
  624.                   FeldName:= Copy(DbFldNam,1,6) + DezStr(a);
  625.                   ArrName:= FldNam + '[' + DezStr(a) + ']';
  626.                 end;
  627.                 if DBFeldList.Indexof(FeldName) > -1 then begin
  628.                   fnx:= 1;
  629.                   Repeat
  630.                     inc(fnx);
  631.                     FeldName:= Copy(DBFldNam,1,6)+DezStr(fnx);
  632.                   Until DBFeldList.Indexof(FeldName) = -1;
  633.                 end;
  634.                 DBFeldList.Add(FeldName);
  635.                 Zeichen:= Chr(39);
  636.                 if Pos('WORD',RStr) > 0 then begin
  637.                   if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
  638.                     FmtWrite(Result,
  639.                     '    %s:= StrDate(DBTable.FieldByName(%s%s%s).AsString);'+CRLF,
  640.                          [ArrName,Zeichen,FeldName,Zeichen]);
  641.                   end
  642.                   else begin
  643.                     FmtWrite(Result,
  644.                     '    %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
  645.                          [ArrName,Zeichen,FeldName,Zeichen]);
  646.                   end;
  647.                 end
  648.                 else if Pos('INTEGER',RStr) > 0 then begin
  649.                   FmtWrite(Result,
  650.                   '    %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
  651.                        [ArrName,Zeichen,FeldName,Zeichen]);
  652.                 end
  653.                 else if Pos('BYTE',RStr) > 0 then begin
  654.                   FmtWrite(Result,
  655.                   '    %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
  656.                        [ArrName,Zeichen,FeldName,Zeichen]);
  657.                 end
  658.                 else if Pos('LONGINT',RStr) > 0 then begin
  659.                   if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
  660.                     FmtWrite(Result,
  661.                     '    %s:= StrDate(DBTable.FieldByName(%s%s%s).AsString);'+CRLF,
  662.                          [ArrName,Zeichen,FeldName,Zeichen]);
  663.                   end
  664.                   else begin
  665.                     FmtWrite(Result,
  666.                     '    %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
  667.                          [ArrName,Zeichen,FeldName,Zeichen]);
  668.                   end;
  669.                 end
  670.                 else if Pos('REAL',RStr) > 0 then begin
  671.                   FmtWrite(Result,
  672.                   '    %s:= DBTable.FieldByName(%s%s%s).AsFloat;'+CRLF,
  673.                        [ArrName,Zeichen,FeldName,Zeichen]);
  674.                 end
  675.                 else if Pos('BOOLEAN',RStr) > 0 then begin
  676.                   FmtWrite(Result,
  677.                   '    %s:= DBTable.FieldByName(%s%s%s).AsBoolean;'+CRLF,
  678.                        [ArrName,Zeichen,FeldName,Zeichen]);
  679.                 end
  680.                 else if Pos('MEMO',RStr) > 0 then begin
  681.                   FmtWrite(Result,
  682.                     '    M:= TMemo.Create(Application);'+CRLF+
  683.                     '    M.Lines.Assign(DBTable.FieldByName(%s%s%s));'+CRLF+
  684.                     '    M.GetTextBuf(MStr,800);'+CRLF+
  685.                     '    Move(MStr,%s,Sizeof(%s));'+CRLF+
  686.                     '    M.Free;'+CRLF,
  687.                        [Zeichen,FeldName,Zeichen,ArrName,ArrName]);
  688.                 end
  689.                 else if (Pos('CHAR',RStr) > 0) and (Pos('ARRAY',RStr) = 0) then begin
  690.                   FmtWrite(Result,
  691.                   '    %s:= DBTable.FieldByName(%s%s%s).AsString[1];'+CRLF,
  692.                        [ArrName,Zeichen,FeldName,Zeichen]);
  693.                 end
  694.                 else begin
  695.                   FmtWrite(Result,
  696.                   '    %s:= DBTable.FieldByName(%s%s%s).AsString;'+CRLF,
  697.                        [ArrName,Zeichen,FeldName,Zeichen]);
  698.                 end;
  699.               end;
  700.             end;
  701.           end;
  702.         end;
  703.         FmtWrite(Result,
  704.           '  end;'+CRLF+
  705.           'end;'+CRLF+CRLF,[NIL]);
  706.       end;
  707.  
  708.       FmtWrite(Result,
  709.         'Function %sKeyProc(Var Daten; KeyNr:Word): IsamKeyStr;'+CRLF+
  710.         'var s : String;'+CRLF+
  711.         'begin'+CRLF+
  712.         '  s:= '+Chr(39)+Chr(39)+';'+CRLF,[RecordName]);
  713.       FmtWrite(Result,
  714.         '  With %s(Daten) do begin'+CRLF+
  715.         '    case KeyNr of'+CRLF,[RecordName]);
  716.       if KeyList.Count > 0 then begin
  717.         k:= 0;
  718.         For x:= 0 to KeyList.Count-1 do begin
  719.           NStr:= KeyList[x];
  720.           NStr:= UpperCase(NStr);
  721.           Strip(NStr);
  722.           if (Pos('KEYBEGIN',NStr) = 0) and (Pos('KEYEND',NStr) = 0) then begin
  723.             inc(K);
  724.             Str(k,xStr);
  725.             FmtWrite(Result,
  726.               '      %s: %s'+CRLF,[xStr,KeyList[x]]);
  727.           end;
  728.         end;
  729.       end
  730.       else FmtWrite(Result,
  731.               '      1 : S:= '+Chr(39)+Chr(39)+';'+CRLF,[NIL]);
  732.       FmtWrite(Result,
  733.         '    end;'+CRLF+
  734.         '  end;'  +CRLF+
  735.         '  %sKEYPROC:= S;'+CRLF+
  736.         'end;'+CRLF+CRLF,[RecordName]);
  737.  
  738.       FmtWrite(Result,
  739.         'procedure T%s.ShowHint(Sender: TObject);'+CRLF+
  740.         'begin'+ CRLF +
  741.         '  StatusBar.Caption := Application.Hint;'+CRLF+
  742.         'end;'+CRLF+CRLF,[FormIdent]);
  743.  
  744.       FmtWrite(Result,
  745.         'procedure T%s.FormCreate(Sender: TObject);'+CRLF+
  746.         'var AktDir: String;' + CRLF +
  747.         'begin' + CRLF +
  748.         '  AktDir:= ExtractFilePath(Application.ExeName);'+CRLF,[FormIdent]);
  749.  
  750.       Str(Sprache,SStr);
  751.       FmtWrite(Result,
  752.         '  KeyListe:= TStringList.Create;'+CRLF+
  753.         '  {Sprache:= %s;  0 = German 1 = English}'+CRLF+
  754.         '  Set_Language;'+CRLF,[SStr]);
  755.  
  756.       if KeyList.Count > 0 then begin
  757.         For i:= 0 to KeyList.Count-1 do begin
  758.           NStr:= KeyList[i];
  759.           if Pos('S:=',NStr) > 0 then begin
  760.             Delete(NStr,1,Pos('S:=',NStr)+2);
  761.             While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
  762.             if Pos(',',NStr) > 0 then NStr:= Copy(NStr,1,Pos(',',NStr)-1)
  763.             else if Pos(';',NStr) > 0 then NStr:= Copy(NStr,1,Pos(';',NStr)-1)
  764.             else if Pos('{',NStr) > 0 then NStr:= Copy(NStr,1,Pos('{',NStr)-1);
  765.             if Pos('}',NStr) > 0 then Delete(NStr,1,Pos('}',NStr));
  766.             if Pos('(',NStr) > 0 then Delete(NStr,1,Pos('(',NStr));
  767.             While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
  768.             FmtWrite(Result,'  KeyListe.Add('+Chr(39)+'%s'+Chr(39)+');'+CRLF,[NStr]);
  769.           end;
  770.         end;
  771.       end;
  772.       FmtWrite(Result,
  773.         '  if KeyListe.Count > 0 then KeyPanel.Caption:= '+
  774.         Chr(39)+'Sort: '+Chr(39)+'+KeyListe[0];'+CRLF,[NIL]);
  775.  
  776.       FmtWrite(Result,
  777.         '  Application.OnHint := ShowHint;'+CRLF+
  778.         '  with %sTable do begin'+CRLF+
  779.         '    Key_Proc :=  %sKEYPROC;'+CRLF,[FormIdent,RecordName]);
  780.       FmtWrite(Result,
  781.         '    Recsize:= Sizeof(%s);'+CRLF,[RecordName]);
  782.       if IIDList.Count > 0 then begin
  783.         For x:= 0 to IIDList.Count-1 do FmtWrite(Result,
  784.         '    %s'+CRLF,[IIDList[x]]);
  785.       end
  786.       else FmtWrite(Result,
  787.         '    IID[1].KeyL := 0; IID[1].AllowDupK := False;'+CRLF,[NIL]);
  788.       FmtWrite(Result,
  789.         '    Active:= True;'+CRLF+
  790.         '  end;'+CRLF+
  791.         '  if %sTable.Active then begin'+CRLF,[FormIdent]);
  792.       FmtWrite(Result,
  793.         '    %sBrowser1.OnBuildRow:= %sBrowser1BuildRow;'+CRLF+
  794.         '    %sBrowser1.ConnectLowBrowser(New(PLowWinBrowser, Init(True, %sTable.IFBPTR,'+CRLF+
  795.         '       1, 50, 1, '+Chr(39)+Chr(39)+', '+Chr(39)+Chr(39)+', %sData, False )));'+CRLF,
  796.            [RecordName,RecordName,RecordName,FormIdent,RecordName]);
  797.       FmtWrite(Result,
  798.         '    %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
  799.         '  end;'+CRLF+
  800.         '  %sBrowser1.BrowserHeader:= Header1;'+CRLF,[RecordName,RecordName]);
  801.       FmtWrite(Result,
  802.         '  ActiveControl:= %sBrowser1;'+CRLF+
  803.         '  Header1.OnSized:= Header1Sized;'+CRLF+
  804.         'end;'+CRLF+CRLF,[RecordName]);
  805.  
  806.       FmtWrite(Result,
  807.       'Procedure T%s.Set_Language;'+CRLF+
  808.       'begin'+CRLF+
  809.       '  if Sprache = 1 then begin {English}'+CRLF+
  810.       '    NeuBttn.Hint   := '+Chr(39)+'New record'+Chr(39)+';'+CRLF,[FormIdent]);
  811.       FmtWrite(Result,
  812.       '    EditBttn.Hint  := '+Chr(39)+'Edit record'+Chr(39)+';'+CRLF+
  813.       '    SuchBttn.Hint  := '+Chr(39)+'Search'+Chr(39)+';'+CRLF+
  814.       '    KeyBttn.Hint   := '+Chr(39)+'sort-order'+Chr(39)+';'+CRLF+
  815.       '    LoeschBttn.Hint:= '+Chr(39)+'Delete'+Chr(39)+';'+CRLF,[NIL]);
  816.       FmtWrite(Result,
  817.       '    ReorgBttn.Hint := '+Chr(39)+'Reorganize table'+Chr(39)+';'+CRLF+
  818.       '    BrwBttn.Hint   := '+Chr(39)+'Setup browser'+Chr(39)+';'+CRLF,[NIL]);
  819.       if CreaBttn then begin
  820.         FmtWrite(Result,
  821.            '    CreateBttn.Hint:= '+Chr(39)+'Create table'+Chr(39)+';'+CRLF,[NIL]);
  822.       end;
  823.       FmtWrite(Result,
  824.       '  end'+CRLF+
  825.       '  else begin'+CRLF+
  826.       '    NeuBttn.Hint   := '+Chr(39)+'Neuer Datensatz'+Chr(39)+';'+CRLF+
  827.       '    EditBttn.Hint  := '+Chr(39)+'Datensatz bearbeiten'+Chr(39)+';'+CRLF,[NIL]);
  828.       FmtWrite(Result,
  829.       '    SuchBttn.Hint  := '+Chr(39)+'Daten suchen'+Chr(39)+';'+CRLF+
  830.       '    KeyBttn.Hint   := '+Chr(39)+'Sortierordnung'+Chr(39)+';'+CRLF+
  831.       '    LoeschBttn.Hint:= '+Chr(39)+'Datensatz l÷schen'+Chr(39)+';'+CRLF+
  832.       '    ReorgBttn.Hint := '+Chr(39)+'Tabelle reorganisieren'+Chr(39)+';'+CRLF+
  833.       '    BrwBttn.Hint   := '+Chr(39)+'Browser einstellen'+Chr(39)+';'+CRLF,[NIL]);
  834.       if CreaBttn then begin
  835.         FmtWrite(Result,
  836.         '    CreateBttn.Hint:= '+Chr(39)+'Tabelle erzeugen'+Chr(39)+';'+CRLF,[NIL]);
  837.       end;
  838.       FmtWrite(Result,
  839.       '  end;'+CRLF+
  840.       'end;'+CRLF,[NIL]);
  841.  
  842.       if alsMainForm then NStr:= 'Close' else NStr:= 'ModalResult:= mrOk';
  843.       FmtWrite(Result,
  844.         'procedure T%s.ExitBttnClick(Sender: TObject);'+CRLF+
  845.         'begin'+CRLF+
  846.         '  %s;'+CRLF+
  847.         'end;'+CRLF+CRLF,[FormIdent,NStr]);
  848.  
  849.       if Sprache = 1 then SStr:= 'Reorganize table ?'
  850.       else SStr:= 'Tabelle reorganisieren ?';
  851.       FmtWrite(Result,
  852.         'Procedure T%s.ReorgBttnClick(Sender: TObject);'+CRLF+
  853.         'var Txt1: String;'+CRLF+
  854.         'begin'+CRLF,[FormIdent]);
  855.       FmtWrite(Result,
  856.         '  if Sprache = 1 then Txt1:= '+Chr(39)+'Reorganize table ?'+Chr(39)+CRLF+
  857.         '  else Txt1:= '+Chr(39)+'Tabelle reorganisieren ?'+Chr(39)+';'+CRLF+
  858.         '  if JaNein(Txt1,'+Chr(39)+Chr(39)+') then begin'+CRLF+
  859.         '    %sTable.Rebuild;'+CRLF,[FormIdent]);
  860.       FmtWrite(Result,
  861.            '    if %sBrowser1.GetLowBrowser <> NIL then'+CRLF+
  862.            '    %sBrowser1.GetLowBrowser^.UsedFileBlock:= %sTable.IfbPtr;'+CRLF+
  863.            '  end;'+CRLF+
  864.            'end;'+CRLF+CRLF,[RecordName,RecordName,FormIdent]);
  865.       FmtWrite(Result,
  866.         'Procedure T%s.BrwBttnClick(Sender: TObject);'+CRLF+
  867.         'begin'+CRLF+
  868.         '  %sBrowser1.SetupBrowser(Self);'+CRLF+
  869.         'end;'+CRLF+CRLF,[FormIdent,RecordName]);
  870.  
  871.       FmtWrite(Result,
  872.         'procedure T%s.FormDestroy(Sender: TObject);'+CRLF+
  873.         'begin'+CRLF+
  874.         '  if %sTable.Active then %sTable.Close;'+CRLF,[FormIdent,FormIdent,FormIdent]);
  875.       FmtWrite(Result,
  876.         '  KeyListe.Free;'+CRLF+
  877.         'end;'+CRLF+CRLF,[NIL]);
  878.  
  879.       FmtWrite(Result,
  880.         'procedure T%s.EditBttnClick(Sender: TObject);'+CRLF+
  881.         'begin'+CRLF+
  882.         '  %s:= T%s.Create(Self);'+CRLF+
  883.         '  Try'+CRLF,[FormIdent,EditFormIdent,EditFormIdent]);
  884.       FmtWrite(Result,
  885.         '    %sTable.Ref:= %sBrowser1.GetCurrentDatRef;'+CRLF+
  886.         '    %s.%sTable:= %sTable;'+CRLF,
  887.               [FormIdent,RecordName,EditFormIdent,EditFormIdent,FormIdent]);
  888.       FmtWrite(Result,
  889.         '    %s.SetData;'+CRLF+
  890.         '    %sTable.FindKey(%sData,%sDup,%sTable.Key);'+CRLF,
  891.               [EditFormIdent,FormIdent,RecordName,RecordName,FormIdent]);
  892.       FmtWrite(Result,
  893.         '    %s.ShowModal;'+CRLF+
  894.         '  Finally'+CRLF+
  895.         '    %s.Free;'+CRLF,[EditFormIdent,EditFormIdent]);
  896.       FmtWrite(Result,
  897.         '    Application.OnHint:= ShowHint;'           + CRLF +
  898.         '    %sBrowser1.SetAndUpdateBrowserScreen(%sTable.Key,%sTable.Ref);'+CRLF,[RecordName,FormIdent,FormIdent]);
  899.       FmtWrite(Result,
  900.         '  End;'+CRLF+
  901.         'end;'+CRLF+CRLF,[NIL]);
  902.  
  903.       FmtWrite(Result,
  904.         'procedure T%s.NeuBttnClick(Sender: TObject);'+CRLF+
  905.         'begin'+CRLF+
  906.         '  %s:= T%s.Create(Self);'+CRLF+
  907.         '  Try'+CRLF,[FormIdent,EditFormIdent,EditFormIdent]);
  908.       FmtWrite(Result,
  909.         '    %s.%sTable:= %sTable;'+CRLF,
  910.               [EditFormIdent,EditFormIdent,FormIdent]);
  911.       FmtWrite(Result,
  912.         '    %s.LeerData;'+CRLF,[EditFormIdent]);
  913.       FmtWrite(Result,
  914.         '    %s.ShowModal;'+CRLF+
  915.         '  Finally'+CRLF+
  916.         '    %s.Free;'+CRLF,[EditFormIdent,EditFormIdent]);
  917.       FmtWrite(Result,
  918.         '    Application.OnHint:= ShowHint;'+ CRLF +
  919.         '  End;'+CRLF+
  920.         'end;'+CRLF+CRLF,[NIL]);
  921.  
  922.       if Sprache = 1 then SStr:= 'Delete record ?'
  923.       else SStr:= 'Datensatz l÷schen ?';
  924.       FmtWrite(Result,
  925.         'procedure T%s.LoeschBttnClick(Sender: TObject);'+CRLF+
  926.         'var Key1,Txt1: String;'+CRLF+
  927.         'begin'+CRLF,[FormIdent]);
  928.       FmtWrite(Result,
  929.         '  %sTable.Ref:= %sBrowser1.GetCurrentDatRef;'+CRLF+
  930.         '  %sTable.Get(%sData,%sDup);'+CRLF,
  931.         [FormIdent,RecordName,FormIdent,RecordName,RecordName]);
  932.  
  933.       FmtWrite(Result,
  934.         '  Key1:= %sTable.Key_Proc(%sData,%sTable.KeyNo);'+CRLF+
  935.         '  if Sprache = 1 then Txt1:= '+Chr(39)+'Delete '+Chr(39)+'+Key1+'+Chr(39)+' ?'+Chr(39)+CRLF+
  936.         '  else Txt1:= '+Chr(39)+'Datensatz '+Chr(39)+'+Key1+'+Chr(39)+' l÷schen ?'+Chr(39)+';'+CRLF,
  937.         [FormIdent,RecordName,FormIdent]);
  938.       FmtWrite(Result,
  939.         '  if Janein(Txt1,'+Chr(39)+Chr(39)+') then %sTable.Delete(%sData,%sDup);'+CRLF,
  940.         [FormIdent,RecordName,RecordName]);
  941.       FmtWrite(Result,
  942.         '  %sbrowser1.SetAndUpdateBrowserScreen(%sTable.Key,%sTable.Ref);'+CRLF+
  943.         'end;'+CRLF+CRLF,
  944.         [RecordName,FormIdent,FormIdent]);
  945.  
  946.       FmtWrite(Result,
  947.           'procedure T%s.SuchBttnClick(Sender: TObject);' + CRLF +
  948.           'var Ref: Longint;'+CRLF+
  949.           '    Key: IsamKeyStr;'+CRLF,[FormIdent]);
  950.       FmtWrite(Result,
  951.           'begin'+CRLF,[NIL]);
  952.       FmtWrite(Result,
  953.           '  if Such_Einstellen(%sTable,Self,%sData,%sDup,Ref,Key,KeyListe) then begin' + CRLF +
  954.           '    %sBrowser1.KeyNumber := %sTable.KeyNo;'+CRLF+
  955.           '    if KeyListe.Count > 0 then KeyPanel.Caption:= '+
  956.           Chr(39)+'Sort: '+Chr(39)+'+KeyListe[%sTable.KeyNo-1];'+CRLF,
  957.            [FormIdent,RecordName,RecordName,RecordName,FormIdent,FormIdent]);
  958.       FmtWrite(Result,
  959.           '    %sBrowser1.SetAndUpdateBrowserScreen(Key, Ref);'+CRLF+
  960.           '    Key_Speichern(GetAppName,%sBrowser1.Name,%sTable.KeyNo);'+CRLF,[RecordName,RecordName,FormIdent]);
  961.       FmtWrite(Result,
  962.           '  end;'+CRLF+
  963.           'end;'+ CRLF + CRLF, [NIL]);
  964.  
  965.       FmtWrite(Result,
  966.           'procedure T%s.KeyBttnClick(Sender: TObject);' + CRLF +
  967.           'var Key1: Integer;'+CRLF,[FormIdent]);
  968.       FmtWrite(Result,
  969.           'begin'+CRLF+
  970.           '  Key1:= %sTable.KeyNo;'+CRLF,[FormIdent]);
  971.       FmtWrite(Result,
  972.           '  Key_Einstellen(Self,Key1,KeyListe);'+CRLF,[NIL]);
  973.       FmtWrite(Result,
  974.           '  %sTable.KeyNo:= Key1;'+CRLF+
  975.           '  if KeyListe.Count > 0 then KeyPanel.Caption:= '+
  976.           Chr(39)+'Sort: '+Chr(39)+'+KeyListe[Key1-1];'+CRLF,
  977.                [FormIdent]);
  978.       FmtWrite(Result,
  979.           '  %sBrowser1.KeyNumber := Key1;'+CRLF,[RecordName]);
  980.       FmtWrite(Result,
  981.           '  Key_Speichern(GetAppName,%sBrowser1.Name,%sTable.KeyNo);'+CRLF+
  982.           '  %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
  983.           'end;'+ CRLF + CRLF, [RecordName,FormIdent,RecordName]);
  984.  
  985.       FmtWrite(Result,
  986.           'procedure T%s.%sTimerTimer(Sender: TObject);'+ CRLF +
  987.           'var TStr: String;'+CRLF+
  988.           'begin'+ CRLF +
  989.           '  TStr:= '+Chr(39)+Chr(39)+';'+CRLF,[FormIdent,FormIdent]);
  990.       FmtWrite(Result,
  991.           '  DateTimeToString(TStr,'+Chr(39)+'dd.mm.yyyy hh:mm'+Chr(39)+',Now);'+CRLF+
  992.           '  ZeitPanel.Caption:= TStr;' + CRLF +
  993.           'end;'+ CRLF + CRLF, [NIL]);
  994.  
  995.       FmtWrite(Result,
  996.           'Procedure T%s.FormResize(Sender: TObject);'+CRLF+
  997.           'begin'+CRLF+
  998.           '  %sBrowser1.Height := ClientHeight-Header1.Height - 10;'+CRLF,[FormIdent,RecordName]);
  999.       FmtWrite(Result,
  1000.           '  %sBrowser1.Width := ClientWidth - 2;'+CRLF+
  1001.           'end;'+CRLF+CRLF,[RecordName]);
  1002.  
  1003.       FmtWrite(Result,
  1004.           'Procedure T%s.FormShow(Sender: TObject);'+CRLF+
  1005.           'begin'+CRLF+
  1006.           '  %sTable.KeyNo:= %sBrowser1.ReadIni;'+CRLF+
  1007.           '  %sBrowser1.ClearIncss;'+CRLF,[FormIdent,FormIdent,RecordName,RecordName]);
  1008.       FmtWrite(Result,
  1009.           '  %sBrowser1.KeyNumber := %sTable.KeyNo;'+CRLF+
  1010.           '  %sBrowser1.KeySection := 0;'+CRLF+
  1011.           '  {%sBrowser1.AllowIncSS := True;}'+CRLF,
  1012.             [RecordName,FormIdent,RecordName,RecordName]);
  1013.       FmtWrite(Result,
  1014.           '  if KeyListe.Count > 0 then KeyPanel.Caption:= '+
  1015.           Chr(39)+'Sort: '+Chr(39)+'+KeyListe[%sTable.KeyNo-1];'+CRLF,
  1016.                [FormIdent]);
  1017.  
  1018.       FmtWrite(Result,
  1019.           '  %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
  1020.           'end;'+CRLF+CRLF,[RecordName]);
  1021.  
  1022.       FmtWrite(Result,
  1023.           'Procedure T%s.Header1Sized(Sender: TObject;  ASection, AWidth: Integer);'+CRLF+
  1024.           'begin'+CRLF+
  1025.           '  %sBrowser1.ResizeHeader;'+CRLF,[FormIdent,RecordName]);
  1026.       FmtWrite(Result,
  1027.           '  %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
  1028.           'end;'+CRLF+CRLF,[RecordName]);
  1029.  
  1030.       FmtWrite(Result,
  1031.           'Function T%s.%sBrowser1BuildRow(Sender: TObject; var RR: RowRec): Integer;'+CRLF+
  1032.           'begin'+CRLF+
  1033.           '  Result := NoError;'+CRLF,[FormIdent,RecordName]);
  1034.       FmtWrite(Result,
  1035.           '  Satzlesen(%sTable.IfbPtr,RR.Ref,%sData,%sDup);'+CRLF+
  1036.           '  with %sData do begin'+CRLF+
  1037.           '    if RR.Status <> NoError then begin'+CRLF,[FormIdent,RecordName,RecordName,RecordName]);
  1038.       FmtWrite(Result,
  1039.           '      RR.Row := F('+Chr(39)+'****  '+Chr(39)+' + RR.IKS, MaxCols);'+CRLF+
  1040.           '    end else begin'+CRLF+
  1041.           '      RR.Row:= %sBrowser1.GetRow(%sGetFeldProc,%sData);'+CRLF,[RecordName,RecordName,RecordName]);
  1042.       FmtWrite(Result,
  1043.           '    end;'+CRLF+
  1044.           '  end;'+CRLF+
  1045.           'end;'+CRLF+CRLF,[NIL]);
  1046.  
  1047.       if DBASE_Export then begin
  1048.         FmtWrite(Result,
  1049.           'procedure T%s.DbExpBttnClick(Sender: TObject);'+CRLF+
  1050.           'begin'+CRLF,[FormIdent]);
  1051.         FmtWrite(Result,
  1052.           '  Isam2DBase(Self,%sTable,%sTable.TableName,'+CRLF+
  1053.           '  '+Chr(39)+'%s'+Chr(39)+', %s_Struktur, %sDbaseExportProc);'+CRLF+
  1054.           'end;'+CRLF+CRLF,[FormIdent,FormIdent,AliasName,RecordName,RecordName]);
  1055.       end;
  1056.  
  1057.       if DBASE_Import then begin
  1058.         FmtWrite(Result,
  1059.           'procedure T%s.DbImpBttnClick(Sender: TObject);'+CRLF+
  1060.           'begin'+CRLF,[FormIdent]);
  1061.         FmtWrite(Result,
  1062.           '  DBase2Isam(Self,%sTable,%sTable.TableName,'+CRLF+
  1063.           '             '+Chr(39)+'%s'+Chr(39)+', %sDbaseImportProc);'+CRLF,
  1064.                [FormIdent,FormIdent,AliasName,RecordName]);
  1065.         FmtWrite(Result,
  1066.           '  %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
  1067.           'end;'+CRLF+CRLF,[RecordName]);
  1068.       end;
  1069.  
  1070.       if CreaBttn then begin
  1071.         FmtWrite(Result,
  1072.           'procedure T%s.CreateBttnClick(Sender: TObject);'+CRLF+
  1073.           'begin'+CRLF+
  1074.           '  if Password(_PW) then begin'+CRLF,[FormIdent]);
  1075.         FmtWrite(Result,
  1076.           '    with %sTable do begin'+CRLF+
  1077.           '      Key_Proc :=  %sKEYPROC;'+CRLF,[FormIdent,RecordName]);
  1078.         FmtWrite(Result,
  1079.           '      Recsize:= Sizeof(%s);'+CRLF,[RecordName]);
  1080.         if IIDList.Count > 0 then begin
  1081.           For x:= 0 to IIDList.Count-1 do FmtWrite(Result,
  1082.           '      %s'+CRLF,[IIDList[x]]);
  1083.           FmtWrite(Result,
  1084.           '    end;'+CRLF,[NIL]);
  1085.         end
  1086.         else FmtWrite(Result,
  1087.           '      IID[1].KeyL := 0; IID[1].AllowDupK := False;'+CRLF+
  1088.           '    end;'+CRLF,[NIL]);
  1089.         FmtWrite(Result,
  1090.           '    %sTable.CreateTable;'+CRLF+
  1091.           '    %sTable.Open;'+CRLF+
  1092.           '    %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
  1093.           '  end;'+CRLF+
  1094.           'end;'+CRLF,[FormIdent,FormIdent,RecordName]);
  1095.       end;
  1096.  
  1097.       if SetupBttnCheck then begin
  1098.         FmtWrite(Result,
  1099.           'procedure T%s.SetupBttnClick(Sender: TObject);'+CRLF+
  1100.           'begin'+CRLF+
  1101.           '  if Password(_PW) then begin'+CRLF,[FormIdent]);
  1102.         FmtWrite(Result,
  1103.           '    LWSetup:= TLwSetup.Create(Self);'+CRLF+
  1104.           '    Try'+CRLF+
  1105.           '      LWSetup.ShowModal;'+CRLF,[NIL]);
  1106.         FmtWrite(Result,
  1107.           '    Finally'+CRLF+
  1108.           '      LWSetup.Free;'+CRLF+
  1109.           '    End;'+CRLF,[NIL]);
  1110.         FmtWrite(Result,
  1111.           '    Set_Language;'+CRLF+
  1112.           '  end;'+CRLF+
  1113.           'end;'+CRLF,[NIL]);
  1114.       end;
  1115.  
  1116.       FmtWrite(Result, 'end.' + CRLF, [nil]);
  1117.       DBFeldList.Free;
  1118.       Result.Position := 0;
  1119.     except
  1120.       Result.Free;
  1121.       raise;
  1122.     end;
  1123.   finally
  1124.     StrDispose(SourceBuffer);
  1125.   end;
  1126. end;
  1127.  
  1128. function Erzeuge_EditorSource(const UnitIdent, FormIdent: string;
  1129.                               RecList,KeyList: TStringList;
  1130.                               Sprache: Integer;
  1131.                               TypDateiName: String): TMemoryStream;
  1132. const
  1133.   CRLF = #13#10;
  1134. Var Decimals,I,Len,Arr1,Arr2,a: integer;
  1135.     G: Byte;
  1136.     FieldDataType: TFieldType;
  1137.     RecordName,FieldName,FeldName,FldName,NStr,SStr,RStr,AStr,DStr: String;
  1138.     MemoName: String;
  1139. begin
  1140.   SourceBuffer := StrAlloc(SourceBufferSize);
  1141.   try
  1142.     Result := TMemoryStream.Create;
  1143.     try
  1144.  
  1145.       { unit header and uses clause }
  1146.       FmtWrite(Result,
  1147.         'unit %s;' + CRLF + CRLF +
  1148.         'interface' + CRLF + CRLF +
  1149.         'uses'#13#10 +
  1150.         '  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,'#13#10 +
  1151.         '  StdCtrls, ExtCtrls, Forms', [UnitIdent]);
  1152.       {$IFDEF NEWINPUTS}
  1153.       FmtWrite(Result,
  1154.         ',DateEdit, NumCtrl, Buttons,'+CRLF,[NIL]);
  1155.       {$ELSE}
  1156.       FmtWrite(Result,
  1157.         ',Buttons,'+CRLF,[NIL]);
  1158.       {$ENDIF}
  1159.       FmtWrite(Result,
  1160.       ' IsamTabl;' + CRLF + CRLF, [nil]);
  1161.  
  1162.       { begin the class declaration }
  1163.       RecordName:= '';
  1164.       MemoName:= '';
  1165.       FmtWrite(Result,'{$I %s}'+CRLF+CRLF,[TypDateiname]);
  1166.  
  1167.       if RecList.Count > 0 then begin
  1168.         For i:= 0 to RecList.Count - 1 do begin
  1169.           {FmtWrite(Result,'  %s'+CRLF,[RecList[i]]);}
  1170.           RStr:= Uppercase(RecList[i]);
  1171.           Strip(RStr);
  1172.           if Pos('=RECORD',RStr) > 0 then RecordName:= Copy(RStr,1,Pos('=RECORD',RStr)-1);
  1173.         end;
  1174.       end;
  1175.       FmtWrite(Result,
  1176.         'type'#13#10 +
  1177.         '  T%s = class(TForm)'#13#10, [FormIdent]);
  1178.  
  1179.       FmtWrite(Result,
  1180.         '    Panel1 : TPanel;'  + CRLF +
  1181.         '    Panel2 : TPanel;'  + CRLF +
  1182.         '    ZeitPanel: TPanel;'+ CRLF +
  1183.         '    HintPanel: TPanel;'+ CRLF +
  1184.         '    %sTimer  : TTimer;'+ CRLF,[FormIdent]);
  1185.       FmtWrite(Result,
  1186.         '    RueckBttn: TSpeedButton;' + CRLF +
  1187.         '    VorBttn: TSpeedButton;'   + CRLF +
  1188.         '    SuchBttn: TSpeedButton;'  + CRLF +
  1189.         '    KeyBttn: TSpeedButton;'   + CRLF +
  1190.         '    NeuBttn: TSpeedButton;'   + CRLF,[NIL]);
  1191.  
  1192.       FmtWrite(Result,
  1193.         '    AnlegBttn: TSpeedButton;' + CRLF +
  1194.         '    AendernBttn: TSpeedButton;' + CRLF,[NIL]);
  1195.  
  1196.       FmtWrite(Result,
  1197.         '    LoeschBttn: TSpeedButton;'  + CRLF +
  1198.         '    OkBttn: TSpeedButton;'      + CRLF +
  1199.         '    AbbruchBttn: TSpeedButton;' + CRLF, [NIL]);
  1200.  
  1201.       FmtWrite(Result,
  1202.         '    %sTable: TIsamTable;'+CRLF,[FormIdent]);
  1203.  
  1204.       if RecList.Count > 0 then begin
  1205.         For i:= 0 to RecList.Count-1 do begin
  1206.           SStr:= RecList[i];
  1207.           if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
  1208.           and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  1209.             G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  1210.             FieldName:= FeldName;
  1211.             FldName:= FeldName;
  1212.             For a:= Arr1 to Arr2 do begin
  1213.               if Arr1 <> Arr2 then begin
  1214.                 Str(A,AStr);
  1215.                 FieldName:= FeldName+AStr;
  1216.               end;
  1217.               {$IFDEF NEWINPUTS}
  1218.               Case G of
  1219.                 1: FmtWrite(Result,
  1220.                       '    %sInput: TDateEdit;'+CRLF+
  1221.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1222.                 2: FmtWrite(Result,
  1223.                       '    %sInput: TNumEdit;'+CRLF+
  1224.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1225.                 3: begin
  1226.                      FmtWrite(Result,
  1227.                       '    %sInput: TMemo;'+CRLF+
  1228.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1229.                      MemoName:= FieldName;
  1230.                    end;
  1231.                 4: begin
  1232.                      FmtWrite(Result,
  1233.                      '     %sInput: TRadioGroup;'+CRLF+
  1234.                      '     %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1235.                    end;
  1236.                 else FmtWrite(Result,
  1237.                       '    %sInput: TStrEdit;'+CRLF+
  1238.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1239.               end;
  1240.               {$ELSE}
  1241.               Case G of
  1242.                 1: FmtWrite(Result,
  1243.                       '    %sInput: TEdit;'+CRLF+
  1244.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1245.                 2: FmtWrite(Result,
  1246.                       '    %sInput: TEdit;'+CRLF+
  1247.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1248.                 3: begin
  1249.                      FmtWrite(Result,
  1250.                       '    %sInput: TMemo;'+CRLF+
  1251.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1252.                      MemoName:= FieldName;
  1253.                    end;
  1254.                 4: begin
  1255.                      FmtWrite(Result,
  1256.                      '     %sInput: TRadioGroup;'+CRLF+
  1257.                      '     %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1258.                    end;
  1259.                 else FmtWrite(Result,
  1260.                       '    %sInput: TEdit;'+CRLF+
  1261.                       '    %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
  1262.               end;
  1263.               {$ENDIF}
  1264.             end; {for arr1 to arr2}
  1265.           end;
  1266.         end;
  1267.       end;
  1268.  
  1269.       FmtWrite(Result,
  1270.         '    procedure FormCreate(Sender: TObject);' + CRLF +
  1271.         '    procedure FormDestroy(Sender: TObject);' + CRLF +
  1272.         '    procedure VorBttnClick(Sender: TObject);'     + CRLF,[NIL]);
  1273.       FmtWrite(Result,
  1274.         '    procedure RueckBttnClick(Sender: TObject);'   + CRLF +
  1275.         '    procedure NeuBttnClick(Sender: TObject);'     + CRLF +
  1276.         '    procedure OkBttnClick(Sender: TObject);'      + CRLF,[NIL]);
  1277.       FmtWrite(Result,
  1278.         '    procedure AbbruchBttnClick(Sender: TObject);' + CRLF,[NIL]);
  1279.       FmtWrite(Result,
  1280.         '    procedure AendernBttnClick(Sender: TObject);' + CRLF +
  1281.         '    procedure AnlegBttnClick(Sender: TObject);'   + CRLF,[NIL]);
  1282.       FmtWrite(Result,
  1283.         '    procedure LoeschBttnClick(Sender: TObject);'  + CRLF +
  1284.         '    procedure SuchBttnClick(Sender: TObject);'    + CRLF +
  1285.         '    procedure KeyBttnClick(Sender: TObject);'     + CRLF, [NIL]);
  1286.  
  1287.       FmtWrite(Result,
  1288.         '    Procedure ShowHint(Sender: TObject);    ' + CRLF +
  1289.         '    Procedure %sTimerTimer(Sender: TObject);'  + CRLF,[FormIdent]);
  1290.       FmtWrite(Result,
  1291.         '    Procedure FormKeyPress(Sender: TObject; var Key: Char);'+CRLF+
  1292.         '  private'+CRLF+
  1293.         '    KeyListe: TStringList;'+CRLF,[NIL]);
  1294.       FmtWrite(Result,
  1295.         '    Function IsModified: Boolean;' + CRLF +
  1296.         '    Procedure ResetModified;'      + CRLF+
  1297.         '    Procedure Set_Language;'+CRLF,[NIL]);
  1298.       FmtWrite(Result,
  1299.         '  public'                          + CRLF,[NIL]);
  1300.       FmtWrite(Result,
  1301.         '    Procedure SetData;'            + CRLF +
  1302.         '    Procedure LeerData;'           + CRLF +
  1303.         '    Procedure GetData;'            + CRLF,
  1304.         [nil]);
  1305.       FmtWrite(Result,
  1306.         '  end;' + CRLF + CRLF +
  1307.         'var' + CRLF +
  1308.         '  %s: T%s;' + CRLF + CRLF,[FormIdent, FormIdent]);
  1309.  
  1310.       FmtWrite(Result,
  1311.         '  %sData,%sDup: %s;' + CRLF + CRLF,[RecordName,RecordName,RecordName]);
  1312.  
  1313.       FmtWrite(Result,
  1314.         'implementation' + CRLF + CRLF +
  1315.         'Uses UToolDll, Isam_Key, IsamSuch, Filer, MyBubble, Dat;' + CRLF + CRLF +
  1316.         '{$R *.DFM}' + CRLF + CRLF, [NIL]);
  1317.  
  1318.       FmtWrite(Result,
  1319.         'procedure T%s.FormCreate(Sender: TObject);' + CRLF +
  1320.         'begin'                                      + CRLF +
  1321.         '  Application.OnHint:= ShowHint;'           + CRLF,[FormIdent]);
  1322.  
  1323.       Str(Sprache,SStr);
  1324.       FmtWrite(Result,
  1325.         '  KeyListe:= TStringList.Create;'+CRLF+
  1326.         '  {Sprache:= %s;  0 = German 1 = English}'+CRLF+
  1327.         '  Set_Language;'+CRLF,[SStr]);
  1328.  
  1329.       if KeyList.Count > 0 then begin
  1330.         For i:= 0 to KeyList.Count-1 do begin
  1331.           NStr:= KeyList[i];
  1332.           if Pos('S:=',NStr) > 0 then begin
  1333.             Delete(NStr,1,Pos('S:=',NStr)+2);
  1334.             While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
  1335.             if Pos(',',NStr) > 0 then NStr:= Copy(NStr,1,Pos(',',NStr)-1)
  1336.             else if Pos(';',NStr) > 0 then NStr:= Copy(NStr,1,Pos(';',NStr)-1)
  1337.             else if Pos('{',NStr) > 0 then NStr:= Copy(NStr,1,Pos('{',NStr)-1);
  1338.             if Pos('}',NStr) > 0 then Delete(NStr,1,Pos('}',NStr));
  1339.             if Pos('(',NStr) > 0 then Delete(NStr,1,Pos('(',NStr));
  1340.             While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
  1341.             FmtWrite(Result,'  KeyListe.Add('+Chr(39)+'%s'+Chr(39)+');'+CRLF,[NStr]);
  1342.           end;
  1343.         end;
  1344.       end;
  1345.       FmtWrite(Result,
  1346.         'end;' + CRLF + CRLF,[NIL]);
  1347.  
  1348.       FmtWrite(Result,
  1349.       'Procedure T%s.Set_Language;'+CRLF+
  1350.       'begin'+CRLF+
  1351.       '  if Sprache = 1 then begin {English}'+CRLF+
  1352.       '    VorBttn.Hint    := '+Chr(39)+'Forward'+Chr(39)+';'+CRLF,[FormIdent]);
  1353.       FmtWrite(Result,
  1354.       '    RueckBttn.Hint  := '+Chr(39)+'Back'+Chr(39)+';'+CRLF+
  1355.       '    SuchBttn.Hint   := '+Chr(39)+'Search'+Chr(39)+';'+CRLF+
  1356.       '    KeyBttn.Hint    := '+Chr(39)+'sort-order'+Chr(39)+';'+CRLF+
  1357.       '    NeuBttn.Hint    := '+Chr(39)+'Clear'+Chr(39)+';'+CRLF,[NIL]);
  1358.       FmtWrite(Result,
  1359.       '    AnlegBttn.Hint  := '+Chr(39)+'Save new record'+Chr(39)+';'+CRLF+
  1360.       '    AendernBttn.Hint:= '+Chr(39)+'Save changed record'+Chr(39)+';'+CRLF+
  1361.       '    LoeschBttn.Hint := '+Chr(39)+'Delete record'+Chr(39)+';'+CRLF+
  1362.       '    AbbruchBttn.Hint:= '+chr(39)+'End'+Chr(39)+';'+CRLF,[NIL]);
  1363.       FmtWrite(Result,
  1364.       '  end'+CRLF+
  1365.       '  else begin'+CRLF+
  1366.       '    VorBttn.Hint    := '+Chr(39)+'VorwΣrts'+Chr(39)+';'+CRLF+
  1367.       '    RueckBttn.Hint  := '+Chr(39)+'Zurⁿck'+Chr(39)+';'+CRLF,[NIL]);
  1368.       FmtWrite(Result,
  1369.       '    SuchBttn.Hint   := '+Chr(39)+'Daten suchen'+Chr(39)+';'+CRLF+
  1370.       '    KeyBttn.Hint    := '+Chr(39)+'Sortierordnung'+Chr(39)+';'+CRLF+
  1371.       '    NeuBttn.Hint    := '+Chr(39)+'Eingabe leeren'+Chr(39)+';'+CRLF+
  1372.       '    AnlegBttn.Hint  := '+Chr(39)+'Datensatz anlegen'+Chr(39)+';'+CRLF,[NIL]);
  1373.       FmtWrite(Result,
  1374.       '    AendernBttn.Hint:= '+Chr(39)+'Datensatz Σndern'+Chr(39)+';'+CRLF+
  1375.       '    LoeschBttn.Hint := '+Chr(39)+'Datensatz l÷schen'+Chr(39)+';'+CRLF+
  1376.       '    AbbruchBttn.Hint:= '+chr(39)+'Ende'+Chr(39)+';'+CRLF,[NIL]);
  1377.       FmtWrite(Result,
  1378.       '  end;'+CRLF+
  1379.       'end;'+CRLF+CRLF,[NIL]);
  1380.  
  1381.       FmtWrite(Result,
  1382.         'procedure T%s.FormDestroy(Sender: TObject);'+CRLF+
  1383.         'begin'+CRLF+
  1384.         '  KeyListe.Free;'+CRLF+
  1385.         'end;'+CRLF+CRLF,[FormIdent]);
  1386.  
  1387.       FmtWrite(Result,
  1388.           'Function T%s.IsModified: Boolean;' + CRLF +
  1389.           'var M: Boolean;'       + CRLF +
  1390.           '    i: Integer;'       + CRLF +
  1391.           'begin'                 + CRLF +
  1392.           '  M:= False;'          + CRLF +
  1393.           '  if ComponentCount > 0 then begin' + CRLF +
  1394.           '    i:= 0;'                         + CRLF,[FormIdent]);
  1395.  
  1396.       FmtWrite(Result,
  1397.           '    Repeat'                         + CRLF +
  1398.           '      if Components[i] is TEdit then begin' + CRLF +
  1399.           '        if TEdit(Components[i]).Modified then M:= True;'+ CRLF +
  1400.           '      end'                                              + CRLF +
  1401.           '      else if Components[i] is TMemo then begin'        + CRLF +
  1402.           '        if TMemo(Components[i]).Modified then M:= True;'+ CRLF,[NIL]);
  1403.       {$IFDEF NEWINPUTS}
  1404.       FmtWrite(Result,
  1405.           '      end'+CRLF+
  1406.           '      else if (Components[i] is TNumEdit) then begin'     + CRLF +
  1407.           '        if TNumEdit(Components[i]).Modified then M:= True;'+ CRLF,[NIL]);
  1408.  
  1409.       FmtWrite(Result,
  1410.           '      end'+CRLF+
  1411.           '      else if (Components[i] is TStrEdit) then begin'+CRLF+
  1412.           '        if TStrEdit(Components[i]).Modified then M:= True;'+CRLF,[NIL]);
  1413.       FmtWrite(Result,
  1414.             '      end'+CRLF+
  1415.             '      else if (Components[i] is TDateEdit) then begin' + CRLF +
  1416.             '        if TDateEdit(Components[i]).Modified then M:= True;'+ CRLF +
  1417.             '      end;'+CRLF,[NIL]);
  1418.       {$ELSE}
  1419.       FmtWrite(Result,
  1420.             '      end;'+CRLF,[NIL]);
  1421.       {$ENDIF}
  1422.       FmtWrite(Result,
  1423.           '      inc(i);'                                           + CRLF +
  1424.           '    Until (i >= ComponentCount) or (M = True);'          + CRLF +
  1425.           '  end;'                                                  + CRLF +
  1426.           '  IsModified:= M;'                                       + CRLF +
  1427.           'end;' + CRLF + CRLF, [NIL]);
  1428.  
  1429.       FmtWrite(Result,
  1430.             'procedure T%s.ResetModified;' + CRLF +
  1431.             'var i: Integer;'              + CRLF +
  1432.             'begin'                        + CRLF +
  1433.             '  if ComponentCount > 0 then begin' + CRLF +
  1434.             '    i:= 0;'                       + CRLF, [FormIdent]);
  1435.  
  1436.       FmtWrite(Result,
  1437.             '    Repeat'                       + CRLF +
  1438.             '      if Components[i] is TEdit then begin' + CRLF +
  1439.             '        TEdit(Components[i]).Modified:= False;' + CRLF +
  1440.             '      end'                                      + CRLF,[NIL]);
  1441.       FmtWrite(Result,
  1442.             '      else if Components[i] is TMemo then begin' + CRLF +
  1443.             '        TMemo(Components[i]).Modified:= False;'  + CRLF,[NIL]);
  1444.       {$IFDEF NEWINPUTS}
  1445.       FmtWrite(Result,
  1446.             '      end'+CRLF+
  1447.             '      else if (Components[i] is TDateEdit) then begin' + CRLF +
  1448.             '        TDateEdit(Components[i]).Modified:= False;'    + CRLF,[NIL]);
  1449.  
  1450.       FmtWrite(Result,
  1451.             '      end'+CRLF+
  1452.             '      else if (Components[i] is TStrEdit) then begin'+CRLF+
  1453.             '        TStrEdit(Components[i]).Modified:= False;' + CRLF,[NIL]);
  1454.  
  1455.       FmtWrite(Result,
  1456.             '      end'+CRLF+
  1457.             '      else if (Components[i] is TNumEdit) then begin' + CRLF +
  1458.             '        TNumEdit(Components[i]).Modified:= False;'+ CRLF +
  1459.             '      end;'+CRLF,[NIL]);
  1460.       {$ELSE}
  1461.       FmtWrite(Result,
  1462.             '      end;' + CRLF,[NIL]);
  1463.       {$ENDIF}
  1464.  
  1465.       FmtWrite(Result,
  1466.             '      inc(i);'                                      + CRLF +
  1467.             '    Until (i >= ComponentCount);'                     + CRLF +
  1468.             '  end;'                                             + CRLF +
  1469.             'end;' + CRLF + CRLF, [NIL]);
  1470.  
  1471.       FmtWrite(Result,
  1472.           'Procedure T%s.SetData;' + CRLF,[FormIdent]);
  1473.       if MemoName <> '' then FmtWrite(Result,
  1474.           'var MStr: Array[0..Sizeof(%sdata.%s)+1] of Char;'+CRLF,[RecordName,MemoName]);
  1475.       FmtWrite(Result,
  1476.           'begin'                            + CRLF+
  1477.           '  Fillchar(%sData,Sizeof(%sData),0);'+CRLF+
  1478.           '  %sTable.Get(%sData,%sDup);'+CRLF,[RecordName,
  1479.                RecordName,FormIdent,RecordName,RecordName]);
  1480.  
  1481.       {$IFDEF NEWINPUTS}
  1482.       if RecList.Count > 0 then begin
  1483.         FmtWrite(Result,'  with %sData do begin'+CRLF,[RecordName]);
  1484.         For i:= 0 to RecList.Count-1 do begin
  1485.           SStr:= RecList[i];
  1486.           if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
  1487.           and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  1488.             G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  1489.             FieldName:= FeldName;
  1490.             FldName:= FeldName;
  1491.             For a:= Arr1 to Arr2 do begin
  1492.               if Arr1 <> Arr2 then begin
  1493.                 Str(A,AStr);
  1494.                 FieldName:= FeldName+'['+AStr+']';
  1495.                 FldName:= FeldName + AStr;
  1496.               end;
  1497.               case FieldDataType of
  1498.                 ftSmallInt,
  1499.                 ftBytes   : FmtWrite(Result,
  1500.                        '    %sInput.Value:= %s;'+CRLF,[FldName,FieldName]);
  1501.                 ftWord,
  1502.                 ftInteger : FmtWrite(Result,
  1503.                        '    %sInput.Value:= %s;'+CRLF,[FldName,FieldName]);
  1504.                 ftDate    : FmtWrite(Result,
  1505.                        '    %sInput.Text:= DateStr(%s);'+CRLF,[FldName,FieldName]);
  1506.                 ftFloat   : FmtWrite(Result,
  1507.                        '    %sInput.Value:= %s;'+CRLF,[FldName,FieldName]);
  1508.                 ftMemo    : FmtWrite(Result,
  1509.                        '    Move(%s,MStr,Sizeof(%s));'+CRLF+
  1510.                        '    %sInput.SetTextBuf(MStr);'+CRLF,[FieldName,FieldName,FldName,FieldName]);
  1511.                 ftBoolean : FmtWrite(Result,
  1512.                        '    if %s then %sInput.ItemIndex:= 1 else %sInput.ItemIndex:= 0;'+CRLF,
  1513.                             [FieldName,FldName,FldName]);
  1514.                 else begin
  1515.                   if Len = 1 then FmtWrite(Result,
  1516.                        '    %sInput.Text:= %s;'+CRLF,[FldName,FieldName])
  1517.                   else FmtWrite(Result,
  1518.                        '    %sInput.Text:= String_oem2ansi(%sTable.AnsiConvert,%s);'+CRLF,[FldName,FormIdent,FieldName]);
  1519.                 end;
  1520.               end;
  1521.             end; {for arr1 to arr2}
  1522.           end;
  1523.         end;
  1524.         FmtWrite(Result,'  end;'+CRLF,[NIL]);
  1525.       end;
  1526.       {$ELSE}
  1527.       if RecList.Count > 0 then begin
  1528.         FmtWrite(Result,'  with %sData do begin'+CRLF,[Recordname]);
  1529.         For i:= 0 to RecList.Count-1 do begin
  1530.           SStr:= RecList[i];
  1531.           if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
  1532.           and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  1533.             G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  1534.             FieldName:= FeldName;
  1535.             FldName:= FeldName;
  1536.             For a:= Arr1 to Arr2 do begin
  1537.               if Arr1 <> Arr2 then begin
  1538.                 Str(A,AStr);
  1539.                 FieldName:= FeldName+'['+AStr+']';
  1540.                 FldName:= FeldName + AStr;
  1541.               end;
  1542.               case FieldDataType of
  1543.                 ftSmallInt,
  1544.                 ftBytes   : FmtWrite(Result,
  1545.                        '    %sInput.Text:= IntStr(%s);'+CRLF,[FldName,FieldName]);
  1546.                 ftWord,
  1547.                 ftInteger : FmtWrite(Result,
  1548.                        '    %sInput.Text:= IntStr(%s);'+CRLF,[FldName,FieldName]);
  1549.                 ftDate    : FmtWrite(Result,
  1550.                        '    %sInput.Text:= DateStr(%s);'+CRLF,[FldName,FieldName]);
  1551.                 ftFloat   : begin
  1552.                               Str(Decimals,DStr);
  1553.                               FmtWrite(Result,
  1554.                               '    %sInput.Text:= SimpleFormDezStr(%s,12,%s);'+CRLF,[FldName,FieldName,DStr]);
  1555.                             end;
  1556.                 ftMemo    : FmtWrite(Result,
  1557.                        '    Move(%s,MStr,Sizeof(%s));'+CRLF+
  1558.                        '    %sInput.SetTextBuf(MStr);'+CRLF,[FieldName,FieldName,FldName,FieldName]);
  1559.                 ftBoolean : FmtWrite(Result,
  1560.                        '    if %s then %sInput.ItemIndex:= 1 else %sInput.ItemIndex:= 0;'+CRLF,
  1561.                             [FieldName,FldName,FldName]);
  1562.                 else begin
  1563.                   if Len = 1 then FmtWrite(Result,
  1564.                        '    %sInput.Text:= %s;'+CRLF,[FldName,FieldName])
  1565.                   else FmtWrite(Result,
  1566.                        '    %sInput.Text:= String_oem2ansi(%sTable.AnsiConvert,%s);'+CRLF,[FldName,FormIdent,FieldName]);
  1567.                 end;
  1568.               end;
  1569.             end; {for arr1 to arr2}
  1570.           end;
  1571.         end;
  1572.         FmtWrite(Result,'  end;'+CRLF,[NIL]);
  1573.       end;
  1574.       {$ENDIF}
  1575.       FmtWrite(Result,
  1576.           '  {AnlegBttn.Enabled:= False;}'     + CRLF +
  1577.           '  {AendernBttn.Enabled:= True;}'    + CRLF +
  1578.           '  {LoeschBttn.Enabled:= True;}'       + CRLF +
  1579.           '  ResetModified;'                   + CRLF +
  1580.           'end;'+ CRLF + CRLF, [NIL]);
  1581.  
  1582.       FmtWrite(Result,
  1583.           'Procedure T%s.GetData;' + CRLF +
  1584.           'var Code: Integer;'+ CRLF,[FormIdent]);
  1585.       if MemoName <> '' then FmtWrite(Result,
  1586.           '    MStr: Array[0..Sizeof(%sData.%s)+1] of Char;'+CRLF,
  1587.           [RecordName,MemoName]);
  1588.       FmtWrite(Result,
  1589.           'begin'                  + CRLF,[NIL]);
  1590.  
  1591.       if RecList.Count > 0 then begin
  1592.         FmtWrite(Result,'  Fillchar(%sData,Sizeof(%sData),0);'+CRLF,[RecordName,RecordName]);
  1593.         FmtWrite(Result,'  with %sData do begin'+CRLF,[RecordName]);
  1594.         For i:= 0 to RecList.Count-1 do begin
  1595.           SStr:= RecList[i];
  1596.           if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
  1597.           and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  1598.             G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  1599.             FieldName:= FeldName;
  1600.             FldName:= FeldName;
  1601.             For a:= Arr1 to Arr2 do begin
  1602.               if Arr1 <> Arr2 then begin
  1603.                 Str(A,AStr);
  1604.                 FieldName:= FeldName+'['+AStr+']';
  1605.                 FldName:= FeldName + AStr;
  1606.               end;
  1607.               Case FieldDataType of
  1608.                 ftSmallInt,
  1609.                 ftBytes   : FmtWrite(Result,
  1610.                               '    %s:= StrInt (%sInput.Text);'+CRLF,[FieldName,FldName]);
  1611.                 ftWord,
  1612.                 ftInteger : FmtWrite(Result,
  1613.                               '    %s:= StrInt(%sInput.Text);'+CRLF,[FieldName,FldName]);
  1614.                 ftDate    : FmtWrite(Result,
  1615.                               '    %s:= StrDate(%sInput.Text);'+CRLF,[FieldName,FldName]);
  1616.                 ftFloat   : FmtWrite(Result,
  1617.                               '    %s:= StrDez (%sInput.Text);'+CRLF,[FieldName,FldName]);
  1618.                 ftMemo    : FmtWrite(Result,
  1619.                               '    %sInput.GetTextBuf(MStr,Sizeof(%s));' + CRLF+
  1620.                               '    Move(MStr,%s,Sizeof(%s));'+CRLF
  1621.                                ,[FldName,FieldName,FieldName,FieldName]);
  1622.                 ftBoolean : FmtWrite(Result,
  1623.                               '    %s:= (%sInput.ItemIndex = 1);'+CRLF,[FieldName,FldName]);
  1624.                 else begin
  1625.                   if Len = 1 then FmtWrite(Result,
  1626.                               '    %s:= %sInput.Text[1];'+CRLF,[FieldName,FldName])
  1627.                   else FmtWrite(Result,
  1628.                               '    %s:= String_ansi2oem(%sTable.AnsiConvert,%sInput.Text);'+CRLF,
  1629.                                     [FieldName,FormIdent,FldName]);
  1630.                 end;
  1631.               end;
  1632.             end;  {for arr1 to arr2}
  1633.           end;
  1634.         end;
  1635.         FmtWrite(Result,'  end;'+CRLF,[NIL]);
  1636.       end;
  1637.  
  1638.       FmtWrite(Result,
  1639.           'end;' + CRLF + CRLF, [NIL]);
  1640.  
  1641.       FmtWrite(Result,
  1642.           'Procedure T%s.LeerData;' + CRLF +
  1643.           'begin'                   + CRLF,[FormIdent]);
  1644.  
  1645.       {$IFDEF NEWINPUTS}
  1646.       if RecList.Count > 0 then begin
  1647.         For i:= 0 to RecList.Count-1 do begin
  1648.           SStr:= RecList[i];
  1649.           if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
  1650.           and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  1651.             G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  1652.             FieldName:= FeldName;
  1653.             FldName:= FeldName;
  1654.             For a:= Arr1 to Arr2 do begin
  1655.               if Arr1 <> Arr2 then begin
  1656.                 Str(A,AStr);
  1657.                 FieldName:= FeldName+'['+AStr+']';
  1658.                 FldName:= FeldName + AStr;
  1659.               end;
  1660.               Case FieldDataType of
  1661.                 ftSmallInt,
  1662.                 ftBytes   : FmtWrite(Result,
  1663.                               '  %sInput.Value:= 0;'+ CRLF,[FldName]);
  1664.                 ftInteger,
  1665.                 ftWord    : FmtWrite(Result,
  1666.                               '  %sInput.Value:= 0;'+CRLF,[FldName]);
  1667.                 ftDate    : FmtWrite(Result,
  1668.                               '  %sInput.Text:= '+Chr(39)+Chr(39)+';'+ CRLF,[FldName]);
  1669.                 ftFloat   : FmtWrite(Result,
  1670.                               '  %sInput.Value:= 0;'+ CRLF,[FldName]);
  1671.                 ftMemo    : FmtWrite(Result,
  1672.                               '  %sInput.Lines.Clear;'+ CRLF,[FldName]);
  1673.                 ftBoolean : FmtWrite(Result,
  1674.                               '  %sInput.ItemIndex:= 0;'+CRLF,[FldName]);
  1675.                 else FmtWrite(Result,
  1676.                          '  %sInput.Text:= '+Chr(39)+ Chr(39)+';'+CRLF,[FldName]);
  1677.               end;
  1678.             end; {for arr1 to arr2}
  1679.           end;
  1680.         end;
  1681.       end;
  1682.       {$ELSE}
  1683.       if RecList.Count > 0 then begin
  1684.         For i:= 0 to RecList.Count-1 do begin
  1685.           SStr:= RecList[i];
  1686.           if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
  1687.           and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  1688.             G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
  1689.             FieldName:= FeldName;
  1690.             FldName:= FeldName;
  1691.             For a:= Arr1 to Arr2 do begin
  1692.               if Arr1 <> Arr2 then begin
  1693.                 Str(A,AStr);
  1694.                 FieldName:= FeldName+'['+AStr+']';
  1695.                 FldName:= FeldName + AStr;
  1696.               end;
  1697.               Case FieldDataType of
  1698.                 ftSmallInt,
  1699.                 ftBytes   : FmtWrite(Result,
  1700.                               '  %sInput.Text:= '+Chr(39)+'0'+Chr(39)+';'+ CRLF,[FldName]);
  1701.                 ftInteger,
  1702.                 ftWord,
  1703.                 ftDate    : FmtWrite(Result,
  1704.                               '  %sInput.Text:= '+Chr(39)+''+Chr(39)+';'+ CRLF,[FldName]);
  1705.                 ftFloat   : FmtWrite(Result,
  1706.                               '  %sInput.Text:= '+Chr(39)+'0.00'+Chr(39)+';'+ CRLF,[FldName]);
  1707.                 ftMemo    : FmtWrite(Result,
  1708.                               '  %sInput.Lines.Clear;'+ CRLF,[FldName]);
  1709.                 ftBoolean : FmtWrite(Result,
  1710.                               '  %sInput.ItemIndex:= 0;'+CRLF,[FldName]);
  1711.                 else FmtWrite(Result,
  1712.                        '  %sInput.Text:= '+Chr(39)+ Chr(39)+';'+CRLF,[FldName]);
  1713.               end;
  1714.             end; {for arr1 to arr2}
  1715.           end;
  1716.         end;
  1717.       end;
  1718.       {$ENDIF}
  1719.       FmtWrite(Result,
  1720.           '  {AnlegBttn.Enabled:= True;}' + CRLF +
  1721.           '  {AendernBttn.Enabled:= False;}' + CRLF +
  1722.           '  {LoeschBttn.Enabled:= False;}' + CRLF  +
  1723.           'end;'                    + CRLF + CRLF, [NIL]);
  1724.  
  1725.       FmtWrite(Result,
  1726.           'procedure T%s.VorBttnClick(Sender: TObject);' + CRLF +
  1727.           'var Txt1: String;'+CRLF+
  1728.           'begin'                                        + CRLF,[FormIdent]);
  1729.  
  1730.       if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
  1731.       else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
  1732.       FmtWrite(Result,
  1733.         '  if (IsModified) then begin'                 + CRLF +
  1734.         '    if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
  1735.         '    else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
  1736.         '    if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Exit;' + CRLF,[NIL]);
  1737.       FmtWrite(Result,
  1738.         '  end;'                                       + CRLF +
  1739.         '  %sTable.Next(%sData,%sDup);'                + CRLF +
  1740.         '  SetData;'                                   + CRLF +
  1741.         'end;'  + CRLF + CRLF, [FormIdent,RecordName,RecordName]);
  1742.  
  1743.       FmtWrite(Result,
  1744.           'procedure T%s.RueckBttnClick(Sender: TObject);' + CRLF +
  1745.           'var Txt1: String;'+CRLF+
  1746.           'begin'                                          + CRLF,[FormIdent]);
  1747.  
  1748.       if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
  1749.       else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
  1750.       FmtWrite(Result,
  1751.         '  if (IsModified) then begin'                   + CRLF +
  1752.         '    if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
  1753.         '    else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
  1754.         '    if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Exit;' + CRLF,[NIL]);
  1755.       FmtWrite(Result,
  1756.         '  end;'                                         + CRLF +
  1757.         '  %sTable.Prior(%sData,%sDup);'                 + CRLF +
  1758.         '  SetData;'                                     + CRLF +
  1759.         'end;'+ CRLF + CRLF, [FormIdent,RecordName,RecordName]);
  1760.  
  1761.       FmtWrite(Result,
  1762.           'procedure T%s.NeuBttnClick(Sender: TObject);' + CRLF +
  1763.           'var Txt1: String;'+CRLF+
  1764.           'begin'                                        + CRLF,[FormIdent]);
  1765.  
  1766.       if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
  1767.       else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
  1768.       FmtWrite(Result,
  1769.           '  if (IsModified) then begin'                 + CRLF +
  1770.           '    if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
  1771.           '    else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
  1772.           '    if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Exit;' + CRLF,[NIL]);
  1773.       FmtWrite(Result,
  1774.           '  end;'                                       + CRLF +
  1775.           '  LeerData;'                                  + CRLF +
  1776.           'end;'+ CRLF + CRLF, [NIL]);
  1777.  
  1778.       NStr:= 'ModalResult:= mrOK';
  1779.  
  1780.       FmtWrite(Result,
  1781.           'procedure T%s.OkBttnClick(Sender: TObject);' + CRLF +
  1782.           'var Txt1: String;'+ CRLF +
  1783.           'begin'           + CRLF,[FormIdent]);
  1784.  
  1785.       if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
  1786.       else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
  1787.       FmtWrite(Result,
  1788.           '  if IsModified then begin' + CRLF +
  1789.           '    if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
  1790.           '    else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
  1791.           '    if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Modalresult:= mrOk' + CRLF,[NIL]);
  1792.       FmtWrite(Result,
  1793.           '    else Exit;' + CRLF +
  1794.           '  end'          + CRLF +
  1795.           '  else %s;' + CRLF+
  1796.           'end;'+ CRLF + CRLF, [NStr]);
  1797.  
  1798.       NStr:= 'ModalResult:= mrCancel';
  1799.  
  1800.       FmtWrite(Result,
  1801.           'procedure T%s.AbbruchBttnClick(Sender: TObject);' + CRLF +
  1802.           'begin'                                            + CRLF,[FormIdent]);
  1803.       FmtWrite(Result,
  1804.           '  OkBttnClick(Sender);'                        + CRLF +
  1805.           'end;'+ CRLF + CRLF, [NStr]);
  1806.  
  1807.       FmtWrite(Result,
  1808.          'procedure T%s.AendernBttnClick(Sender: TObject);' + CRLF +
  1809.          'var R: TRect;'+CRLF+
  1810.          '    Txt1,Txt2: String;'+CRLF+
  1811.          'begin'       + CRLF +
  1812.          '  GetData;' + CRLF +
  1813.          '  %sTable.UpdateRecord(%sData,%sDup);' + CRLF,
  1814.          [FormIdent,FormIdent,RecordName,RecordName]);
  1815.       if Sprache = 1 then SStr:= Chr(39)+'Record'+Chr(39)+','+Chr(39)+'updated'+Chr(39)
  1816.       else SStr:= Chr(39)+'Datensatz'+Chr(39)+','+Chr(39)+'geΣndert'+Chr(39);
  1817.       FmtWrite(Result,
  1818.          '  R:= Bounds(AendernBttn.Left+Self.Left-8,AendernBttn.Top+Self.top+50,32,32);'+CRLF+
  1819.          '  if Sprache = 1 then begin'+CRLF+
  1820.          '     Txt1:= '+Chr(39)+'Record'+Chr(39)+';'+CRLF+
  1821.          '     Txt2:= '+chr(39)+'updated'+Chr(39)+';'+CRLF+
  1822.          '  end'+CRLF,[NIL]);
  1823.       FmtWrite(Result,
  1824.          '  else begin'+CRLF+
  1825.          '     Txt1:= '+chr(39)+'Datensatz'+Chr(39)+';'+CRLF+
  1826.          '     Txt2:= '+chr(39)+'geΣndert'+Chr(39)+';'+CRLF+
  1827.          '  end;'+CRLF,[NIL]);
  1828.       FmtWrite(Result,
  1829.          '  ShowBubble(Self,R,800,Txt1,Txt2);'+CRLF+
  1830.          '  ResetModified;' + CRLF +
  1831.          'end;' + CRLF + CRLF,[NIL]);
  1832.  
  1833.       FmtWrite(Result,
  1834.          'procedure T%s.AnlegBttnClick(Sender: TObject);' + CRLF +
  1835.          'var R: TRect;'+CRLF+
  1836.          '    Txt1,Txt2: String;'+CRLF+
  1837.          'begin'              + CRLF +
  1838.          '  GetData;'       + CRLF,[FormIdent]);
  1839.       FmtWrite(Result,
  1840.          '  %sTable.Insert(%sData,%sDup);' + CRLF,
  1841.          [FormIdent,RecordName,RecordName]);
  1842.       if Sprache = 1 then SStr:= Chr(39)+'New Record'+Chr(39)+','+Chr(39)+'saved'+Chr(39)
  1843.       else SStr:= Chr(39)+'Datensatz'+Chr(39)+','+Chr(39)+'angelegt'+Chr(39);
  1844.       FmtWrite(Result,
  1845.          '  R:= Bounds(AnlegBttn.Left+Self.Left-8,AnlegBttn.Top+Self.top+50,32,32);'+CRLF+
  1846.          '  if Sprache = 1 then begin'+CRLF+
  1847.          '     Txt1:= '+Chr(39)+'New record'+Chr(39)+';'+CRLF+
  1848.          '     Txt2:= '+chr(39)+'saved'+Chr(39)+';'+CRLF+
  1849.          '  end'+CRLF,[NIL]);
  1850.       FmtWrite(Result,
  1851.          '  else begin'+CRLF+
  1852.          '     Txt1:= '+chr(39)+'Datensatz'+Chr(39)+';'+CRLF+
  1853.          '     Txt2:= '+chr(39)+'angelegt'+Chr(39)+';'+CRLF+
  1854.          '  end;'+CRLF,[NIL]);
  1855.       FmtWrite(Result,
  1856.          '  ShowBubble(Self,R,800,Txt1,Txt2);'+CRLF+
  1857.          '  ResetModified;' + CRLF +
  1858.          'end;' + CRLF + CRLF,[NIL]);
  1859.  
  1860.       FmtWrite(Result,
  1861.           'procedure T%s.LoeschBttnClick(Sender: TObject);' + CRLF +
  1862.           'var Key1,Txt1,Txt2: String;'+CRLF+
  1863.           '    R: TRect;'+CRLF+
  1864.           'begin'      + CRLF +
  1865.           '  GetData;' + CRLF,[FormIdent]);
  1866.       FmtWrite(Result,
  1867.           '  Key1:= %sTable.Key_Proc(%sData,%sTable.KeyNo);'+CRLF+
  1868.           '  if Sprache = 1 then Txt1:= '+Chr(39)+'Delete '+Chr(39)+'+Key1+'+Chr(39)+' ?'+Chr(39)+CRLF+
  1869.           '  else Txt1:= '+Chr(39)+'Datensatz '+Chr(39)+'+Key1+'+Chr(39)+' l÷schen ?'+Chr(39)+';'+CRLF,
  1870.           [FormIdent,RecordName,FormIdent]);
  1871.       FmtWrite(Result,
  1872.           '  if Janein(Txt1,'+Chr(39)+Chr(39)+') then %sTable.Delete(%sData,%sDup);'+CRLF,
  1873.           [FormIdent,RecordName,RecordName]);
  1874.       if Sprache = 1 then SStr:= Chr(39)+'Record'+Chr(39)+','+Chr(39)+'deleted'+Chr(39)
  1875.       else SStr:= Chr(39)+'Datensatz'+Chr(39)+','+Chr(39)+'gel÷scht'+Chr(39);
  1876.  
  1877.       FmtWrite(Result,
  1878.          '  R:= Bounds(LoeschBttn.Left+Self.Left-8,LoeschBttn.Top+Self.top+50,32,32);'+CRLF+
  1879.          '  if Sprache = 1 then begin'+CRLF+
  1880.          '     Txt1:= '+Chr(39)+'Record'+Chr(39)+';'+CRLF+
  1881.          '     Txt2:= '+chr(39)+'deleted'+Chr(39)+';'+CRLF+
  1882.          '  end'+CRLF,[NIL]);
  1883.       FmtWrite(Result,
  1884.          '  else begin'+CRLF+
  1885.          '     Txt1:= '+chr(39)+'Datensatz'+Chr(39)+';'+CRLF+
  1886.          '     Txt2:= '+chr(39)+'gel÷scht'+Chr(39)+';'+CRLF+
  1887.          '  end;'+CRLF,[NIL]);
  1888.       FmtWrite(Result,
  1889.          '  ShowBubble(Self,R,800,Txt1,Txt2);'+CRLF+
  1890.          '  ResetModified;' + CRLF +
  1891.          'end;'+ CRLF + CRLF, [NIL]);
  1892.  
  1893.       FmtWrite(Result,
  1894.           'procedure T%s.SuchBttnClick(Sender: TObject);' + CRLF +
  1895.           'var Ref: Longint;'+CRLF+
  1896.           '    Key: IsamKeyStr;'+CRLF+
  1897.           'begin'          + CRLF,[FormIdent]);
  1898.       FmtWrite(Result,
  1899.           '  if Such_Einstellen(%sTable,Self,%sData,%sDup,Ref,Key,KeyListe) then begin' + CRLF +
  1900.           '    SetData;' + CRLF,[FormIdent,RecordName,RecordName]);
  1901.       FmtWrite(Result,
  1902.           '  end;'+CRLF+
  1903.           'end;'+ CRLF + CRLF, [NIL]);
  1904.  
  1905.       FmtWrite(Result,
  1906.           'procedure T%s.KeyBttnClick(Sender: TObject);' + CRLF +
  1907.           'var Key1: Integer;'+CRLF,[FormIdent]);
  1908.       FmtWrite(Result,
  1909.           'begin'+CRLF+
  1910.           '  Key1:= %sTable.KeyNo;'+CRLF,[Formident]);
  1911.       FmtWrite(Result,
  1912.           '  Key_Einstellen(Self,Key1,KeyListe);'+CRLF+
  1913.           '  %sTable.KeyNo:= Key1;'+CRLF+
  1914.           'end;'+ CRLF + CRLF, [FormIdent]);
  1915.  
  1916.       FmtWrite(Result,
  1917.           'procedure T%s.%sTimerTimer(Sender: TObject);'+ CRLF +
  1918.           'var TStr: String;'+CRLF+
  1919.           'begin'+ CRLF +
  1920.           '  TStr:= '+Chr(39)+Chr(39)+';'+CRLF,[FormIdent,FormIdent]);
  1921.       FmtWrite(Result,
  1922.           '  DateTimeToString(TStr,'+Chr(39)+'dd.mm.yyyy hh:mm'+Chr(39)+',Now);'+CRLF+
  1923.           '  ZeitPanel.Caption:= TStr;' + CRLF +
  1924.           'end;'+ CRLF + CRLF, [NIL]);
  1925.  
  1926.       FmtWrite(Result,
  1927.           'Procedure T%s.ShowHint(Sender: TObject);' + CRLF +
  1928.           'begin' + CRLF +
  1929.           '  HintPanel.Caption:= Application.Hint;'  + CRLF +
  1930.           'end;' + CRLF + CRLF,[FormIdent]);
  1931.  
  1932.       FmtWrite(Result,
  1933.           'Procedure T%s.FormKeyPress(Sender: TObject; var Key: Char);'+CRLF+
  1934.           'begin'+CRLF+
  1935.           '  if Key = #13 then begin'+CRLF+
  1936.           '    if not(ActiveControl is TMemo) then begin'+CRLF,[FormIdent]);
  1937.       FmtWrite(Result,
  1938.           '      Key := #0;'+CRLF+
  1939.           '      Perform(WM_NEXTDLGCTL, 0, 0);'+CRLF+
  1940.           '    end;'+CRLF+
  1941.           '  end;'+CRLF+
  1942.           'end;'+CRLF+CRLF,[NIL]);
  1943.  
  1944.       FmtWrite(Result, 'end.' + CRLF, [nil]);
  1945.       Result.Position := 0;
  1946.  
  1947.     except
  1948.       Result.Free;
  1949.       raise;
  1950.     end;
  1951.  
  1952.   finally
  1953.     StrDispose(SourceBuffer);
  1954.   end;
  1955. end;
  1956.  
  1957. end.
  1958.